cabal-install 3.10.1.0 → 3.10.2.0

raw patch · 24 files changed

+1710/−1262 lines, 24 filesdep +base64-bytestringdep ~QuickCheckdep ~directorydep ~filepathnew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: base64-bytestring

Dependency ranges changed: QuickCheck, directory, filepath, resolv

API changes (from Hackage documentation)

Files

• cabal-install.cabal +8/−8
• changelog +3/−0
• main/Main.hs +11/−1010
• src/Distribution/Client/CmdInstall.hs +25/−6
• src/Distribution/Client/CmdListBin.hs +6/−2
• src/Distribution/Client/CmdRun.hs +35/−29
• src/Distribution/Client/CmdUpdate.hs +6/−4
• src/Distribution/Client/Config.hs +74/−47
• src/Distribution/Client/Dependency.hs +38/−12
• src/Distribution/Client/HashValue.hs +5/−0
• src/Distribution/Client/Init/Interactive/Command.hs +5/−6
• src/Distribution/Client/Init/NonInteractive/Command.hs +6/−4
• src/Distribution/Client/Init/NonInteractive/Heuristics.hs +12/−7
• src/Distribution/Client/Main.hs +1013/−0
• src/Distribution/Client/ProjectConfig.hs +10/−0
• src/Distribution/Client/ProjectPlanning.hs +12/−11
• src/Distribution/Client/ScriptUtils.hs +91/−28
• src/Distribution/Client/Setup.hs +77/−47
• src/Distribution/Deprecated/ParseUtils.hs +37/−19
• tests/IntegrationTests2.hs +225/−3
• tests/UnitTests/Distribution/Client/ArbitraryInstances.hs +1/−6
• tests/UnitTests/Distribution/Client/Init/FileCreators.hs +3/−1
• tests/UnitTests/Distribution/Client/Init/NonInteractive.hs +7/−2
• tests/UnitTests/Distribution/Solver/Modular/Solver.hs +0/−10

@@ -1,7 +1,7 @@ Cabal-Version:      2.2  Name:               cabal-install-Version:            3.10.1.0+Version:            3.10.2.0 Synopsis:           The command-line interface for Cabal and Hackage. Description:     The \'cabal\' command-line program simplifies the process of managing@@ -46,7 +46,7 @@       ghc-options: -Wunused-packages  common base-dep-    build-depends: base >=4.10 && <4.18+    build-depends: base >=4.10 && <4.19  common cabal-dep     build-depends: Cabal ^>=3.10@@ -140,6 +140,7 @@         Distribution.Client.InstallSymlink         Distribution.Client.JobControl         Distribution.Client.List+        Distribution.Client.Main         Distribution.Client.Manpage         Distribution.Client.ManpageFlags         Distribution.Client.Nix@@ -204,6 +205,7 @@         async      >= 2.0      && < 2.3,         array      >= 0.4      && < 0.6,         base16-bytestring >= 0.1.1 && < 1.1.0.0,+        base64-bytestring >= 1.0 && < 1.3,         binary     >= 0.7.3    && < 0.9,         bytestring >= 0.10.6.0 && < 0.12,         containers >= 0.5.6.2  && < 0.7,@@ -235,7 +237,7 @@       if os(windows)         build-depends: windns      >= 0.1.0 && < 0.2       else-        build-depends: resolv      >= 0.1.1 && < 0.2+        build-depends: resolv      >= 0.1.1 && < 0.3      if os(windows)       -- newer directory for symlinks@@ -252,7 +254,7 @@   executable cabal-    import: warnings, base-dep, cabal-dep, cabal-syntax-dep+    import: warnings, base-dep     main-is: Main.hs     hs-source-dirs: main     default-language: Haskell2010@@ -264,9 +266,7 @@         extra-libraries: bsd      build-depends:-        cabal-install,-        directory,-        filepath+        cabal-install  -- Small, fast running tests. --@@ -335,7 +335,7 @@           tasty-quickcheck,           tasty-hunit >= 0.10,           tree-diff,-          QuickCheck >= 2.14 && <2.15+          QuickCheck >= 2.14.3 && <2.15   -- Tests to run with a limited stack and heap size

@@ -1,5 +1,8 @@ -*-change-log-*- +3.10.2.0 Hécate <hecate+github@glitchbra.in> August 2023+	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.10.2.0.md+ 3.10.1.0 Mikolaj Konarski <mikolaj@well-typed.com> March 2023 	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.10.1.0.md 

@@ -1,1010 +1,11 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE ScopedTypeVariables #-}---------------------------------------------------------------------------------- |--- Module      :  Main--- Copyright   :  (c) David Himmelstrup 2005--- License     :  BSD-like------ Maintainer  :  lemmih@gmail.com--- Stability   :  provisional--- Portability :  portable------ Entry point to the default cabal-install front-end.--------------------------------------------------------------------------------module Main (main) where--import Distribution.Client.Setup-         ( GlobalFlags(..), globalCommand, withRepoContext-         , ConfigFlags(..)-         , ConfigExFlags(..), defaultConfigExFlags, configureExCommand-         , reconfigureCommand-         , configCompilerAux', configPackageDB'-         , BuildFlags(..)-         , buildCommand, replCommand, testCommand, benchmarkCommand-         , InstallFlags(..), defaultInstallFlags-         , installCommand-         , FetchFlags(..), fetchCommand-         , FreezeFlags(..), freezeCommand-         , genBoundsCommand-         , GetFlags(..), getCommand, unpackCommand-         , checkCommand-         , formatCommand-         , ListFlags(..), listCommand, listNeedsCompiler-         , InfoFlags(..), infoCommand-         , UploadFlags(..), uploadCommand-         , ReportFlags(..), reportCommand-         , runCommand-         , InitFlags(initVerbosity, initHcPath), initCommand-         , ActAsSetupFlags(..), actAsSetupCommand-         , UserConfigFlags(..), userConfigCommand-         , reportCommand-         , manpageCommand-         , haddockCommand-         , cleanCommand-         , copyCommand-         , registerCommand-         )-import Distribution.Simple.Setup-         ( HaddockTarget(..)-         , HaddockFlags(..), defaultHaddockFlags-         , HscolourFlags(..), hscolourCommand-         , ReplFlags(..)-         , CopyFlags(..)-         , RegisterFlags(..)-         , CleanFlags(..)-         , TestFlags(..), BenchmarkFlags(..)-         , Flag(..), fromFlag, fromFlagOrDefault, flagToMaybe, toFlag-         , configAbsolutePaths-         )--import Prelude ()-import Distribution.Client.Compat.Prelude hiding (get)--import Distribution.Client.SetupWrapper-         ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )-import Distribution.Client.Config-         ( SavedConfig(..), loadConfig, defaultConfigFile, userConfigDiff-         , userConfigUpdate, createDefaultConfigFile, getConfigFilePath )-import Distribution.Client.Targets-         ( readUserTargets )-import qualified Distribution.Client.List as List-         ( list, info )--import qualified Distribution.Client.CmdConfigure as CmdConfigure-import qualified Distribution.Client.CmdUpdate    as CmdUpdate-import qualified Distribution.Client.CmdBuild     as CmdBuild-import qualified Distribution.Client.CmdRepl      as CmdRepl-import qualified Distribution.Client.CmdFreeze    as CmdFreeze-import qualified Distribution.Client.CmdHaddock   as CmdHaddock-import qualified Distribution.Client.CmdHaddockProject as CmdHaddockProject-import qualified Distribution.Client.CmdInstall   as CmdInstall-import qualified Distribution.Client.CmdRun       as CmdRun-import qualified Distribution.Client.CmdTest      as CmdTest-import qualified Distribution.Client.CmdBench     as CmdBench-import qualified Distribution.Client.CmdExec      as CmdExec-import qualified Distribution.Client.CmdClean     as CmdClean-import qualified Distribution.Client.CmdSdist     as CmdSdist-import qualified Distribution.Client.CmdListBin   as CmdListBin-import qualified Distribution.Client.CmdOutdated  as CmdOutdated-import           Distribution.Client.CmdLegacy--import Distribution.Client.Install            (install)-import Distribution.Client.Configure          (configure, writeConfigFlags)-import Distribution.Client.Fetch              (fetch)-import Distribution.Client.Freeze             (freeze)-import Distribution.Client.GenBounds          (genBounds)-import Distribution.Client.Check as Check     (check)---import Distribution.Client.Clean            (clean)-import qualified Distribution.Client.Upload as Upload-import Distribution.Client.Run                (run, splitRunArgs)-import Distribution.Client.Get                (get)-import Distribution.Client.Reconfigure        (Check(..), reconfigure)-import Distribution.Client.Nix                (nixInstantiate-                                              ,nixShell-                                              )-import Distribution.Client.Sandbox            (loadConfigOrSandboxConfig-                                              ,findSavedDistPref-                                              ,updateInstallDirs)-import Distribution.Client.Tar                (createTarGzFile)-import Distribution.Client.Types.Credentials  (Password (..))-import Distribution.Client.Init               (initCmd)-import Distribution.Client.Manpage            (manpageCmd)-import Distribution.Client.ManpageFlags       (ManpageFlags (..))-import Distribution.Client.Utils-         ( determineNumJobs, relaxEncodingErrors )-import Distribution.Client.Signal-         ( installTerminationHandler )-import Distribution.Client.Version-         ( cabalInstallVersion )--import Distribution.Package (packageId)-import Distribution.PackageDescription-         ( BuildType(..), Executable(..), buildable )--import Distribution.PackageDescription.PrettyPrint-         ( writeGenericPackageDescription )-import qualified Distribution.Simple as Simple-import qualified Distribution.Make as Make-import qualified Distribution.Types.UnqualComponentName as Make-import Distribution.Simple.Build-         ( startInterpreter )-import Distribution.Simple.Command-         ( CommandParse(..), CommandUI(..), Command, CommandSpec(..)-         , CommandType(..), commandsRun, commandAddAction, hiddenCommand-         , commandFromSpec, commandShowOptions )-import Distribution.Simple.Compiler (PackageDBStack)-import Distribution.Simple.Configure-         ( configCompilerAuxEx, ConfigStateFileError(..)-         , getPersistBuildConfig, interpretPackageDbFlags-         , tryGetPersistBuildConfig )-import qualified Distribution.Simple.LocalBuildInfo as LBI-import Distribution.Simple.PackageDescription ( readGenericPackageDescription )-import Distribution.Simple.Program (defaultProgramDb-                                   ,configureAllKnownPrograms-                                   ,simpleProgramInvocation-                                   ,getProgramInvocationOutput)-import Distribution.Simple.Program.Db (reconfigurePrograms)-import qualified Distribution.Simple.Setup as Cabal-import Distribution.Simple.Utils-         ( cabalVersion, die', dieNoVerbosity, info, notice, topHandler-         , findPackageDesc, tryFindPackageDesc, createDirectoryIfMissingVerbose )-import Distribution.Text-         ( display )-import Distribution.Verbosity as Verbosity-         ( normal )-import Distribution.Version-         ( Version, mkVersion, orLaterVersion )--import Distribution.Compat.ResponseFile-import System.Environment       (getArgs, getProgName)-import System.FilePath          ( dropExtension, splitExtension-                                , takeExtension, (</>), (<.>) )-import System.IO                ( BufferMode(LineBuffering), hSetBuffering-                                , hPutStrLn, stderr, stdout )-import System.Directory         ( doesFileExist, getCurrentDirectory-                                , withCurrentDirectory)-import Data.Monoid              (Any(..))-import Control.Exception        (AssertionFailed, assert, try)----- | Entry point----main :: IO ()-main = do-  installTerminationHandler-  -- Enable line buffering so that we can get fast feedback even when piped.-  -- This is especially important for CI and build systems.-  hSetBuffering stdout LineBuffering--  -- If the locale encoding for CLI doesn't support all Unicode characters,-  -- printing to it may fail unless we relax the handling of encoding errors-  -- when writing to stderr and stdout.-  relaxEncodingErrors stdout-  relaxEncodingErrors stderr-  (args0, args1) <- break (== "--") <$> getArgs-  mainWorker =<< (++ args1) <$> expandResponse args0---- | Check whether assertions are enabled and print a warning in that case.-warnIfAssertionsAreEnabled :: IO ()-warnIfAssertionsAreEnabled =-  assert False (return ()) `catch`-  (\(_e :: AssertionFailed) -> hPutStrLn stderr assertionsEnabledMsg)-    -- Andreas, 2022-12-30, issue #8654:-    -- The verbosity machinery is not in place at this point (option -v not parsed),-    -- so instead of using function @warn@, we print straight to stderr.-  where-    assertionsEnabledMsg =-      "Warning: this is a debug build of cabal-install with assertions enabled."--mainWorker :: [String] -> IO ()-mainWorker args = do-  topHandler $-    case commandsRun (globalCommand commands) commands args of-      CommandHelp   help                 -> printGlobalHelp help-      CommandList   opts                 -> printOptionsList opts-      CommandErrors errs                 -> printErrors errs-      CommandReadyToGo (globalFlags, commandParse)  ->-        case commandParse of-          _ | fromFlagOrDefault False (globalVersion globalFlags)-              -> printVersion-            | fromFlagOrDefault False (globalNumericVersion globalFlags)-              -> printNumericVersion-          CommandHelp     help           -> printCommandHelp help-          CommandList     opts           -> printOptionsList opts--          CommandErrors   errs           -> do-            -- Check whether cabal is called from a script, like #!/path/to/cabal.-            case args of-              []      -> printErrors errs-              script : scriptArgs -> CmdRun.validScript script >>= \case-                False -> printErrors errs-                True  -> do-                  -- In main operation (not help, version etc.) print warning if assertions are on.-                  warnIfAssertionsAreEnabled-                  CmdRun.handleShebang script scriptArgs--          CommandReadyToGo action        -> do-            -- In main operation (not help, version etc.) print warning if assertions are on.-            warnIfAssertionsAreEnabled-            action globalFlags--  where-    printCommandHelp help = do-      pname <- getProgName-      putStr (help pname)-    printGlobalHelp help = do-      pname <- getProgName-      configFile <- defaultConfigFile-      putStr (help pname)-      putStr $ "\nYou can edit the cabal configuration file to set defaults:\n"-            ++ "  " ++ configFile ++ "\n"-      exists <- doesFileExist configFile-      unless exists $-          putStrLn $ "This file will be generated with sensible "-                  ++ "defaults if you run 'cabal update'."-    printOptionsList = putStr . unlines-    printErrors errs = dieNoVerbosity $ intercalate "\n" errs-    printNumericVersion = putStrLn $ display cabalInstallVersion-    printVersion        = putStrLn $ "cabal-install version "-                                  ++ display cabalInstallVersion-                                  ++ "\ncompiled using version "-                                  ++ display cabalVersion-                                  ++ " of the Cabal library "--    commands = map commandFromSpec commandSpecs-    commandSpecs =-      [ regularCmd listCommand listAction-      , regularCmd infoCommand infoAction-      , regularCmd fetchCommand fetchAction-      , regularCmd getCommand getAction-      , regularCmd unpackCommand unpackAction-      , regularCmd checkCommand checkAction-      , regularCmd uploadCommand uploadAction-      , regularCmd reportCommand reportAction-      , regularCmd initCommand initAction-      , regularCmd userConfigCommand userConfigAction-      , regularCmd genBoundsCommand genBoundsAction-      , regularCmd CmdOutdated.outdatedCommand CmdOutdated.outdatedAction-      , wrapperCmd hscolourCommand hscolourVerbosity hscolourDistPref-      , hiddenCmd  formatCommand formatAction-      , hiddenCmd  actAsSetupCommand actAsSetupAction-      , hiddenCmd  manpageCommand (manpageAction commandSpecs)-      , regularCmd CmdListBin.listbinCommand     CmdListBin.listbinAction--      ] ++ concat-      [ newCmd  CmdConfigure.configureCommand CmdConfigure.configureAction-      , newCmd  CmdUpdate.updateCommand       CmdUpdate.updateAction-      , newCmd  CmdBuild.buildCommand         CmdBuild.buildAction-      , newCmd  CmdRepl.replCommand           CmdRepl.replAction-      , newCmd  CmdFreeze.freezeCommand       CmdFreeze.freezeAction-      , newCmd  CmdHaddock.haddockCommand     CmdHaddock.haddockAction-      , newCmd  CmdHaddockProject.haddockProjectCommand-                                              CmdHaddockProject.haddockProjectAction-      , newCmd  CmdInstall.installCommand     CmdInstall.installAction-      , newCmd  CmdRun.runCommand             CmdRun.runAction-      , newCmd  CmdTest.testCommand           CmdTest.testAction-      , newCmd  CmdBench.benchCommand         CmdBench.benchAction-      , newCmd  CmdExec.execCommand           CmdExec.execAction-      , newCmd  CmdClean.cleanCommand         CmdClean.cleanAction-      , newCmd  CmdSdist.sdistCommand         CmdSdist.sdistAction--      , legacyCmd configureExCommand configureAction-      , legacyCmd buildCommand buildAction-      , legacyCmd replCommand replAction-      , legacyCmd freezeCommand freezeAction-      , legacyCmd haddockCommand haddockAction-      , legacyCmd installCommand installAction-      , legacyCmd runCommand runAction-      , legacyCmd testCommand testAction-      , legacyCmd benchmarkCommand benchmarkAction-      , legacyCmd cleanCommand cleanAction-      , legacyWrapperCmd copyCommand copyVerbosity copyDistPref-      , legacyWrapperCmd registerCommand regVerbosity regDistPref-      , legacyCmd reconfigureCommand reconfigureAction-      ]--type Action = GlobalFlags -> IO ()---- Duplicated in Distribution.Client.CmdLegacy. Any changes must be--- reflected there, as well.-regularCmd :: CommandUI flags -> (flags -> [String] -> action)-           -> CommandSpec action-regularCmd ui action =-  CommandSpec ui ((flip commandAddAction) action) NormalCommand--hiddenCmd :: CommandUI flags -> (flags -> [String] -> action)-          -> CommandSpec action-hiddenCmd ui action =-  CommandSpec ui (\ui' -> hiddenCommand (commandAddAction ui' action))-  HiddenCommand--wrapperCmd :: Monoid flags => CommandUI flags -> (flags -> Flag Verbosity)-           -> (flags -> Flag String) -> CommandSpec Action-wrapperCmd ui verbosity distPref =-  CommandSpec ui (\ui' -> wrapperAction ui' verbosity distPref) NormalCommand--wrapperAction :: Monoid flags-              => CommandUI flags-              -> (flags -> Flag Verbosity)-              -> (flags -> Flag String)-              -> Command Action-wrapperAction command verbosityFlag distPrefFlag =-  commandAddAction command-    { commandDefaultFlags = mempty } $ \flags extraArgs globalFlags -> do-    let verbosity = fromFlagOrDefault normal (verbosityFlag flags)-    load <- try (loadConfigOrSandboxConfig verbosity globalFlags)-    let config = either (\(SomeException _) -> mempty) id load-    distPref <- findSavedDistPref config (distPrefFlag flags)-    let setupScriptOptions = defaultSetupScriptOptions { useDistPref = distPref }-    setupWrapper verbosity setupScriptOptions Nothing-                 command (const flags) (const extraArgs)--configureAction :: (ConfigFlags, ConfigExFlags)-                -> [String] -> Action-configureAction (configFlags, configExFlags) extraArgs globalFlags = do-  let verbosity = fromFlagOrDefault normal (configVerbosity configFlags)-  config <- updateInstallDirs (configUserInstall configFlags)-                          <$> loadConfigOrSandboxConfig verbosity globalFlags-  distPref <- findSavedDistPref config (configDistPref configFlags)-  nixInstantiate verbosity distPref True globalFlags config-  nixShell verbosity distPref globalFlags config $ do-    let configFlags'   = savedConfigureFlags   config `mappend` configFlags-        configExFlags' = savedConfigureExFlags config `mappend` configExFlags-        globalFlags'   = savedGlobalFlags      config `mappend` globalFlags-    (comp, platform, progdb) <- configCompilerAuxEx configFlags'--    writeConfigFlags verbosity distPref (configFlags', configExFlags')--    -- What package database(s) to use-    let packageDBs :: PackageDBStack-        packageDBs-          = interpretPackageDbFlags-            (fromFlag (configUserInstall configFlags'))-            (configPackageDBs configFlags')--    withRepoContext verbosity globalFlags' $ \repoContext ->-        configure verbosity packageDBs repoContext-                  comp platform progdb configFlags' configExFlags' extraArgs--reconfigureAction :: (ConfigFlags, ConfigExFlags)-                  -> [String] -> Action-reconfigureAction flags@(configFlags, _) _ globalFlags = do-  let verbosity = fromFlagOrDefault normal (configVerbosity configFlags)-  config <- updateInstallDirs (configUserInstall configFlags)-                          <$> loadConfigOrSandboxConfig verbosity globalFlags-  distPref <- findSavedDistPref config (configDistPref configFlags)-  let checkFlags = Check $ \_ saved -> do-        let flags' = saved <> flags-        unless (saved == flags') $ info verbosity message-        pure (Any True, flags')-        where-          -- This message is correct, but not very specific: it will list all-          -- of the new flags, even if some have not actually changed. The-          -- *minimal* set of changes is more difficult to determine.-          message =-            "flags changed: "-            ++ unwords (commandShowOptions configureExCommand flags)-  nixInstantiate verbosity distPref True globalFlags config-  _ <--    reconfigure configureAction-    verbosity distPref NoFlag-    checkFlags [] globalFlags config-  pure ()--buildAction :: BuildFlags -> [String] -> Action-buildAction buildFlags extraArgs globalFlags = do-  let verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags)-  config <- loadConfigOrSandboxConfig verbosity globalFlags-  distPref <- findSavedDistPref config (buildDistPref buildFlags)-  -- Calls 'configureAction' to do the real work, so nothing special has to be-  -- done to support sandboxes.-  config' <--    reconfigure configureAction-    verbosity distPref (buildNumJobs buildFlags)-    mempty [] globalFlags config-  nixShell verbosity 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 config distPref buildFlags extraArgs =-  setupWrapper verbosity setupOptions Nothing-               (Cabal.buildCommand progDb) mkBuildFlags (const extraArgs)-  where-    progDb       = defaultProgramDb-    setupOptions = defaultSetupScriptOptions { useDistPref = distPref }--    mkBuildFlags version = filterBuildFlags version config buildFlags'-    buildFlags' = buildFlags-      { buildVerbosity = toFlag verbosity-      , buildDistPref  = 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-  | version >= mkVersion [1,19,1] = buildFlags_latest-  -- Cabal < 1.19.1 doesn't support 'build -j'.-  | otherwise                      = buildFlags_pre_1_19_1-  where-    buildFlags_pre_1_19_1 = buildFlags {-      buildNumJobs = NoFlag-      }-    buildFlags_latest     = buildFlags {-      -- Take the 'jobs' setting config file into account.-      buildNumJobs = Flag . Just . determineNumJobs $-                     (numJobsConfigFlag `mappend` numJobsCmdLineFlag)-      }-    numJobsConfigFlag  = installNumJobs . savedInstallFlags $ config-    numJobsCmdLineFlag = buildNumJobs buildFlags---replAction :: ReplFlags -> [String] -> Action-replAction replFlags extraArgs globalFlags = do-  let verbosity = fromFlagOrDefault normal (replVerbosity replFlags)-  config <- loadConfigOrSandboxConfig verbosity globalFlags-  distPref <- findSavedDistPref config (replDistPref replFlags)-  cwd     <- getCurrentDirectory-  pkgDesc <- findPackageDesc cwd-  let-    -- There is a .cabal file in the current directory: start a REPL and load-    -- the project's modules.-    onPkgDesc = do-      -- Calls 'configureAction' to do the real work, so nothing special has to-      -- be done to support sandboxes.-      _ <--        reconfigure configureAction-        verbosity distPref NoFlag-        mempty [] globalFlags config-      let progDb = defaultProgramDb-          setupOptions = defaultSetupScriptOptions-            { useCabalVersion = orLaterVersion $ mkVersion [1,18,0]-            , useDistPref     = distPref-            }-          replFlags'   = replFlags-            { replVerbosity = toFlag verbosity-            , replDistPref  = toFlag distPref-            }--      nixShell verbosity distPref globalFlags config $-        setupWrapper verbosity setupOptions Nothing (Cabal.replCommand progDb) (const replFlags') (const extraArgs)--    -- No .cabal file in the current directory: just start the REPL (possibly-    -- using the sandbox package DB).-    onNoPkgDesc = do-      let configFlags = savedConfigureFlags config-      (comp, platform, programDb) <- configCompilerAux' configFlags-      programDb' <- reconfigurePrograms verbosity-                                        (replProgramPaths replFlags)-                                        (replProgramArgs replFlags)-                                        programDb-      nixShell verbosity distPref globalFlags config $ do-        startInterpreter verbosity programDb' comp platform-                        (configPackageDB' configFlags)--  either (const onNoPkgDesc) (const onPkgDesc) pkgDesc--installAction :: ( ConfigFlags, ConfigExFlags, InstallFlags-                 , HaddockFlags, TestFlags, BenchmarkFlags )-              -> [String] -> Action-installAction (configFlags, _, installFlags, _, _, _) _ globalFlags-  | fromFlagOrDefault False (installOnly installFlags) = do-      let verb = fromFlagOrDefault normal (configVerbosity configFlags)-      config <- loadConfigOrSandboxConfig verb globalFlags-      dist <- findSavedDistPref config (configDistPref configFlags)-      let setupOpts = defaultSetupScriptOptions { useDistPref = dist }-      setupWrapper-        verb setupOpts Nothing-        installCommand (const (mempty, mempty, mempty, mempty, mempty, mempty))-                       (const [])--installAction-  ( configFlags, configExFlags, installFlags-  , haddockFlags, testFlags, benchmarkFlags )-  extraArgs globalFlags = do-  let verb = fromFlagOrDefault normal (configVerbosity configFlags)-  config <- updateInstallDirs (configUserInstall configFlags)-                          <$> loadConfigOrSandboxConfig verb globalFlags--  dist <- findSavedDistPref config (configDistPref configFlags)--  do-    targets <- readUserTargets verb extraArgs--    let configFlags'    = maybeForceTests installFlags' $-                          savedConfigureFlags   config `mappend`-                          configFlags { configDistPref = toFlag dist }-        configExFlags'  = defaultConfigExFlags         `mappend`-                          savedConfigureExFlags config `mappend` configExFlags-        installFlags'   = defaultInstallFlags          `mappend`-                          savedInstallFlags     config `mappend` installFlags-        haddockFlags'   = defaultHaddockFlags          `mappend`-                          savedHaddockFlags     config `mappend`-                          haddockFlags { haddockDistPref = toFlag dist }-        testFlags'      = Cabal.defaultTestFlags       `mappend`-                          savedTestFlags        config `mappend`-                          testFlags { testDistPref = toFlag dist }-        benchmarkFlags' = Cabal.defaultBenchmarkFlags  `mappend`-                          savedBenchmarkFlags   config `mappend`-                          benchmarkFlags { benchmarkDistPref = toFlag dist }-        globalFlags'    = savedGlobalFlags      config `mappend` globalFlags-    (comp, platform, progdb) <- configCompilerAux' configFlags'--    -- TODO: Redesign ProgramDB API to prevent such problems as #2241 in the-    -- future.-    progdb' <- configureAllKnownPrograms verb progdb--    configFlags'' <- configAbsolutePaths configFlags'--    withRepoContext verb globalFlags' $ \repoContext ->-        install verb-                (configPackageDB' configFlags'')-                repoContext-                comp platform progdb'-                globalFlags' configFlags'' configExFlags'-                installFlags' haddockFlags' testFlags' benchmarkFlags'-                targets--      where-        -- '--run-tests' implies '--enable-tests'.-        maybeForceTests installFlags' configFlags' =-          if fromFlagOrDefault False (installRunTests installFlags')-          then configFlags' { configTests = toFlag True }-          else configFlags'--testAction :: (BuildFlags, TestFlags) -> [String] -> GlobalFlags-           -> IO ()-testAction (buildFlags, testFlags) extraArgs globalFlags = do-  let verbosity      = fromFlagOrDefault normal (buildVerbosity buildFlags)-  config <- loadConfigOrSandboxConfig verbosity globalFlags-  distPref <- findSavedDistPref config (testDistPref testFlags)-  let buildFlags'    = buildFlags-                      { buildVerbosity = testVerbosity testFlags }-      checkFlags = Check $ \_ flags@(configFlags, configExFlags) ->-        if fromFlagOrDefault False (configTests configFlags)-          then pure (mempty, flags)-          else do-            info verbosity "reconfiguring to enable tests"-            let flags' = ( configFlags { configTests = toFlag True }-                        , configExFlags-                        )-            pure (Any True, flags')--  _ <--    reconfigure configureAction-    verbosity distPref (buildNumJobs buildFlags')-    checkFlags [] globalFlags config-  nixShell verbosity distPref globalFlags config $ do-    let setupOptions   = defaultSetupScriptOptions { useDistPref = distPref }-        testFlags'     = testFlags { testDistPref = toFlag distPref }--    -- The package was just configured, so the LBI must be available.-    names <- componentNamesFromLBI verbosity distPref "test suites"-              (\c -> case c of { LBI.CTest{} -> True; _ -> False })-    let extraArgs'-          | null extraArgs = case names of-            ComponentNamesUnknown -> []-            ComponentNames names' -> [ Make.unUnqualComponentName name-                                    | LBI.CTestName name <- names' ]-          | otherwise      = extraArgs--    build verbosity config distPref buildFlags' extraArgs'-    setupWrapper verbosity setupOptions Nothing Cabal.testCommand (const testFlags') (const extraArgs')--data ComponentNames = ComponentNamesUnknown-                    | ComponentNames [LBI.ComponentName]---- | Return the names of all buildable components matching a given predicate.-componentNamesFromLBI :: Verbosity -> FilePath -> String-                         -> (LBI.Component -> Bool)-                         -> IO ComponentNames-componentNamesFromLBI verbosity distPref targetsDescr compPred = do-  eLBI <- tryGetPersistBuildConfig distPref-  case eLBI of-    Left err -> case err of-      -- Note: the build config could have been generated by a custom setup-      -- script built against a different Cabal version, so it's crucial that-      -- we ignore the bad version error here.-      ConfigStateFileBadVersion _ _ _ -> return ComponentNamesUnknown-      _                               -> die' verbosity (show err)-    Right lbi -> do-      let pkgDescr = LBI.localPkgDescr lbi-          names    = map LBI.componentName-                     . filter (buildable . LBI.componentBuildInfo)-                     . filter compPred $-                     LBI.pkgComponents pkgDescr-      if null names-        then do notice verbosity $ "Package has no buildable "-                  ++ targetsDescr ++ "."-                exitSuccess -- See #3215.--        else return $! (ComponentNames names)--benchmarkAction :: (BuildFlags, BenchmarkFlags)-                   -> [String] -> GlobalFlags-                   -> IO ()-benchmarkAction-  (buildFlags, benchmarkFlags)-  extraArgs globalFlags = do-  let verbosity      = fromFlagOrDefault normal-                       (buildVerbosity buildFlags)--  config <- loadConfigOrSandboxConfig verbosity globalFlags-  distPref <- findSavedDistPref config (benchmarkDistPref benchmarkFlags)-  let buildFlags'    = buildFlags-                      { buildVerbosity = benchmarkVerbosity benchmarkFlags }--  let checkFlags = Check $ \_ flags@(configFlags, configExFlags) ->-        if fromFlagOrDefault False (configBenchmarks configFlags)-          then pure (mempty, flags)-          else do-            info verbosity "reconfiguring to enable benchmarks"-            let flags' = ( configFlags { configBenchmarks = toFlag True }-                        , configExFlags-                        )-            pure (Any True, flags')--  config' <--    reconfigure configureAction-    verbosity distPref (buildNumJobs buildFlags')-    checkFlags [] globalFlags config-  nixShell verbosity distPref globalFlags config $ do-    let setupOptions   = defaultSetupScriptOptions { useDistPref = distPref }-        benchmarkFlags'= benchmarkFlags { benchmarkDistPref = toFlag distPref }--    -- The package was just configured, so the LBI must be available.-    names <- componentNamesFromLBI verbosity distPref "benchmarks"-            (\c -> case c of { LBI.CBench{} -> True; _ -> False; })-    let extraArgs'-          | null extraArgs = case names of-            ComponentNamesUnknown -> []-            ComponentNames names' -> [ Make.unUnqualComponentName name-                                    | LBI.CBenchName name <- names']-          | otherwise      = extraArgs--    build verbosity config' distPref buildFlags' extraArgs'-    setupWrapper verbosity setupOptions Nothing Cabal.benchmarkCommand (const benchmarkFlags') (const extraArgs')--haddockAction :: HaddockFlags -> [String] -> Action-haddockAction haddockFlags extraArgs globalFlags = do-  let verbosity = fromFlag (haddockVerbosity haddockFlags)-  config <- loadConfigOrSandboxConfig verbosity globalFlags-  distPref <- findSavedDistPref config (haddockDistPref haddockFlags)-  config' <--    reconfigure configureAction-    verbosity distPref NoFlag-    mempty [] globalFlags config-  nixShell verbosity distPref globalFlags config $ do-    let haddockFlags' = defaultHaddockFlags      `mappend`-                        savedHaddockFlags config' `mappend`-                        haddockFlags { haddockDistPref = toFlag distPref }-        setupScriptOptions = defaultSetupScriptOptions-                             { useDistPref = distPref }-    setupWrapper verbosity setupScriptOptions Nothing-      haddockCommand (const haddockFlags') (const extraArgs)-    when (haddockForHackage haddockFlags == Flag ForHackage) $ do-      pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig distPref)-      let dest = distPref </> name <.> "tar.gz"-          name = display (packageId pkg) ++ "-docs"-          docDir = distPref </> "doc" </> "html"-      createTarGzFile dest docDir name-      notice verbosity $ "Documentation tarball created: " ++ dest--cleanAction :: CleanFlags -> [String] -> Action-cleanAction cleanFlags extraArgs globalFlags = do-  load <- try (loadConfigOrSandboxConfig verbosity globalFlags)-  let config = either (\(SomeException _) -> mempty) id load-  distPref <- findSavedDistPref config (cleanDistPref cleanFlags)-  let setupScriptOptions = defaultSetupScriptOptions-                           { useDistPref = distPref-                           , useWin32CleanHack = True-                           }-      cleanFlags' = cleanFlags { cleanDistPref = toFlag distPref }-  setupWrapper verbosity setupScriptOptions Nothing-               cleanCommand (const cleanFlags') (const extraArgs)-  where-    verbosity = fromFlagOrDefault normal (cleanVerbosity cleanFlags)--listAction :: ListFlags -> [String] -> Action-listAction listFlags extraArgs globalFlags = do-  let verbosity = fromFlag (listVerbosity listFlags)-  config <- loadConfigOrSandboxConfig verbosity globalFlags-  let configFlags' = savedConfigureFlags config-      configFlags  = configFlags'-        { configPackageDBs = configPackageDBs configFlags'-                           `mappend` listPackageDBs listFlags-        , configHcPath     = listHcPath listFlags-        }-      globalFlags' = savedGlobalFlags    config `mappend` globalFlags-  compProgdb <- if listNeedsCompiler listFlags-      then do-          (comp, _, progdb) <- configCompilerAux' configFlags-          return (Just (comp, progdb))-      else return Nothing-  withRepoContext verbosity globalFlags' $ \repoContext ->-    List.list verbosity-       (configPackageDB' configFlags)-       repoContext-       compProgdb-       listFlags-       extraArgs--infoAction :: InfoFlags -> [String] -> Action-infoAction infoFlags extraArgs globalFlags = do-  let verbosity = fromFlag (infoVerbosity infoFlags)-  targets <- readUserTargets verbosity extraArgs-  config <- loadConfigOrSandboxConfig verbosity globalFlags-  let configFlags' = savedConfigureFlags config-      configFlags  = configFlags' {-        configPackageDBs = configPackageDBs configFlags'-                           `mappend` infoPackageDBs infoFlags-        }-      globalFlags' = savedGlobalFlags    config `mappend` globalFlags-  (comp, _, progdb) <- configCompilerAuxEx configFlags-  withRepoContext verbosity globalFlags' $ \repoContext ->-    List.info verbosity-       (configPackageDB' configFlags)-       repoContext-       comp-       progdb-       globalFlags'-       infoFlags-       targets--fetchAction :: FetchFlags -> [String] -> Action-fetchAction fetchFlags extraArgs globalFlags = do-  let verbosity = fromFlag (fetchVerbosity fetchFlags)-  targets <- readUserTargets verbosity extraArgs-  config <- loadConfig verbosity (globalConfigFile globalFlags)-  let configFlags  = savedConfigureFlags config-      globalFlags' = savedGlobalFlags config `mappend` globalFlags-  (comp, platform, progdb) <- configCompilerAux' configFlags-  withRepoContext verbosity globalFlags' $ \repoContext ->-    fetch verbosity-        (configPackageDB' configFlags)-        repoContext-        comp platform progdb globalFlags' fetchFlags-        targets--freezeAction :: FreezeFlags -> [String] -> Action-freezeAction freezeFlags _extraArgs globalFlags = do-  let verbosity = fromFlag (freezeVerbosity freezeFlags)-  config <- loadConfigOrSandboxConfig verbosity globalFlags-  distPref <- findSavedDistPref config NoFlag-  nixShell verbosity distPref globalFlags config $ do-    let configFlags  = savedConfigureFlags config-        globalFlags' = savedGlobalFlags config `mappend` globalFlags-    (comp, platform, progdb) <- configCompilerAux' configFlags--    withRepoContext verbosity globalFlags' $ \repoContext ->-        freeze verbosity-            (configPackageDB' configFlags)-            repoContext-            comp platform progdb-            globalFlags' freezeFlags--genBoundsAction :: FreezeFlags -> [String] -> GlobalFlags -> IO ()-genBoundsAction freezeFlags _extraArgs globalFlags = do-  let verbosity = fromFlag (freezeVerbosity freezeFlags)-  config <- loadConfigOrSandboxConfig verbosity globalFlags-  distPref <- findSavedDistPref config NoFlag-  nixShell verbosity distPref globalFlags config $ do-    let configFlags  = savedConfigureFlags config-        globalFlags' = savedGlobalFlags config `mappend` globalFlags-    (comp, platform, progdb) <- configCompilerAux' configFlags--    withRepoContext verbosity globalFlags' $ \repoContext ->-        genBounds verbosity-                (configPackageDB' configFlags)-                repoContext-                comp platform progdb-                globalFlags' freezeFlags--uploadAction :: UploadFlags -> [String] -> Action-uploadAction uploadFlags extraArgs globalFlags = do-  config <- loadConfig verbosity (globalConfigFile globalFlags)-  let uploadFlags' = savedUploadFlags config `mappend` uploadFlags-      globalFlags' = savedGlobalFlags config `mappend` globalFlags-      tarfiles     = extraArgs-  when (null tarfiles && not (fromFlag (uploadDoc uploadFlags'))) $-    die' verbosity "the 'upload' command expects at least one .tar.gz archive."-  checkTarFiles extraArgs-  maybe_password <--    case uploadPasswordCmd uploadFlags'-    of Flag (xs:xss) -> Just . Password <$>-                        getProgramInvocationOutput verbosity-                        (simpleProgramInvocation xs xss)-       _             -> pure $ flagToMaybe $ uploadPassword uploadFlags'-  withRepoContext verbosity globalFlags' $ \repoContext -> do-    if fromFlag (uploadDoc uploadFlags')-    then do-      when (length tarfiles > 1) $-       die' verbosity $ "the 'upload' command can only upload documentation "-             ++ "for one package at a time."-      tarfile <- maybe (generateDocTarball config) return $ listToMaybe tarfiles-      Upload.uploadDoc verbosity-                       repoContext-                       (flagToMaybe $ uploadUsername uploadFlags')-                       maybe_password-                       (fromFlag (uploadCandidate uploadFlags'))-                       tarfile-    else do-      Upload.upload verbosity-                    repoContext-                    (flagToMaybe $ uploadUsername uploadFlags')-                    maybe_password-                    (fromFlag (uploadCandidate uploadFlags'))-                    tarfiles-    where-    verbosity = fromFlag (uploadVerbosity uploadFlags)-    checkTarFiles tarfiles-      | not (null otherFiles)-      = die' verbosity $ "the 'upload' command expects only .tar.gz archives: "-           ++ intercalate ", " otherFiles-      | otherwise = sequence_-                      [ do exists <- doesFileExist tarfile-                           unless exists $ die' verbosity $ "file not found: " ++ tarfile-                      | tarfile <- tarfiles ]--      where otherFiles = filter (not . isTarGzFile) tarfiles-            isTarGzFile file = case splitExtension file of-              (file', ".gz") -> takeExtension file' == ".tar"-              _              -> False-    generateDocTarball config = do-      notice verbosity $-        "No documentation tarball specified. "-        ++ "Building a documentation tarball with default settings...\n"-        ++ "If you need to customise Haddock options, "-        ++ "run 'haddock --for-hackage' first "-        ++ "to generate a documentation tarball."-      haddockAction (defaultHaddockFlags { haddockForHackage = Flag ForHackage })-                    [] globalFlags-      distPref <- findSavedDistPref config NoFlag-      pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig distPref)-      return $ distPref </> display (packageId pkg) ++ "-docs" <.> "tar.gz"--checkAction :: Flag Verbosity -> [String] -> Action-checkAction verbosityFlag extraArgs _globalFlags = do-  let verbosity = fromFlag verbosityFlag-  unless (null extraArgs) $-    die' verbosity $ "'check' doesn't take any extra arguments: " ++ unwords extraArgs-  allOk <- Check.check (fromFlag verbosityFlag)-  unless allOk exitFailure--formatAction :: Flag Verbosity -> [String] -> Action-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-  -- Uses 'writeFileAtomic' under the hood.-  writeGenericPackageDescription path pkgDesc--reportAction :: ReportFlags -> [String] -> Action-reportAction reportFlags extraArgs globalFlags = do-  let verbosity = fromFlag (reportVerbosity reportFlags)-  unless (null extraArgs) $-    die' verbosity $ "'report' doesn't take any extra arguments: " ++ unwords extraArgs-  config <- loadConfig verbosity (globalConfigFile globalFlags)-  let globalFlags' = savedGlobalFlags config `mappend` globalFlags-      reportFlags' = savedReportFlags config `mappend` reportFlags--  withRepoContext verbosity globalFlags' $ \repoContext ->-   Upload.report verbosity repoContext-    (flagToMaybe $ reportUsername reportFlags')-    (flagToMaybe $ reportPassword reportFlags')--runAction :: BuildFlags -> [String] -> Action-runAction buildFlags extraArgs globalFlags = do-  let verbosity   = fromFlagOrDefault normal (buildVerbosity buildFlags)-  config <- loadConfigOrSandboxConfig verbosity globalFlags-  distPref <- findSavedDistPref config (buildDistPref buildFlags)-  config' <--    reconfigure configureAction-    verbosity distPref (buildNumJobs buildFlags)-    mempty [] globalFlags config-  nixShell verbosity distPref globalFlags config $ do-    lbi <- getPersistBuildConfig distPref-    (exe, exeArgs) <- splitRunArgs verbosity lbi extraArgs--    build verbosity config' distPref buildFlags ["exe:" ++ display (exeName exe)]-    run verbosity lbi exe exeArgs--getAction :: GetFlags -> [String] -> Action-getAction getFlags extraArgs globalFlags = do-  let verbosity = fromFlag (getVerbosity getFlags)-  targets <- readUserTargets verbosity extraArgs-  config <- loadConfigOrSandboxConfig verbosity globalFlags-  let globalFlags' = savedGlobalFlags config `mappend` globalFlags-  withRepoContext verbosity (savedGlobalFlags config) $ \repoContext ->-   get verbosity-    repoContext-    globalFlags'-    getFlags-    targets--unpackAction :: GetFlags -> [String] -> Action-unpackAction getFlags extraArgs globalFlags = do-  getAction getFlags extraArgs globalFlags--initAction :: InitFlags -> [String] -> Action-initAction initFlags extraArgs globalFlags = do-  -- it takes the first value within extraArgs (if there's one)-  -- and uses it as the root directory for the new project-  case extraArgs of-    [] -> initAction'-    [projectDir] -> do-      createDirectoryIfMissingVerbose verbosity True projectDir-      withCurrentDirectory projectDir initAction'-    _ -> die' verbosity $-      "'init' only takes a single, optional, extra " ++-      "argument for the project root directory"-  where-    initAction' = do-      confFlags <- loadConfigOrSandboxConfig verbosity globalFlags-      -- override with `--with-compiler` from CLI if available-      let confFlags' = savedConfigureFlags confFlags `mappend` compFlags-          initFlags' = savedInitFlags confFlags `mappend` initFlags-          globalFlags' = savedGlobalFlags confFlags `mappend` globalFlags--      (comp, _, progdb) <- configCompilerAux' confFlags'--      withRepoContext verbosity globalFlags' $ \repoContext ->-        initCmd verbosity (configPackageDB' confFlags')-          repoContext comp progdb initFlags'--    verbosity = fromFlag (initVerbosity initFlags)-    compFlags = mempty { configHcPath = initHcPath initFlags }--userConfigAction :: UserConfigFlags -> [String] -> Action-userConfigAction ucflags extraArgs globalFlags = do-  let verbosity  = fromFlag (userConfigVerbosity ucflags)-      frc        = fromFlag (userConfigForce ucflags)-      extraLines = fromFlag (userConfigAppendLines ucflags)-  case extraArgs of-    ("init":_) -> do-      path       <- configFile-      fileExists <- doesFileExist path-      if (not fileExists || (fileExists && frc))-      then void $ createDefaultConfigFile verbosity extraLines path-      else die' verbosity $ path ++ " already exists."-    ("diff":_) -> traverse_ putStrLn =<< userConfigDiff verbosity globalFlags extraLines-    ("update":_) -> userConfigUpdate verbosity globalFlags extraLines-    -- Error handling.-    [] -> die' verbosity $ "Please specify a subcommand (see 'help user-config')"-    _  -> die' verbosity $ "Unknown 'user-config' subcommand: " ++ unwords extraArgs-  where configFile = getConfigFilePath (globalConfigFile globalFlags)---- | Used as an entry point when cabal-install needs to invoke itself--- as a setup script. This can happen e.g. when doing parallel builds.----actAsSetupAction :: ActAsSetupFlags -> [String] -> Action-actAsSetupAction actAsSetupFlags args _globalFlags =-  let bt = fromFlag (actAsSetupBuildType actAsSetupFlags)-  in case bt of-    Simple    -> Simple.defaultMainArgs args-    Configure -> Simple.defaultMainWithHooksArgs-                  Simple.autoconfUserHooks args-    Make      -> Make.defaultMainArgs args-    Custom    -> error "actAsSetupAction Custom"--manpageAction :: [CommandSpec action] -> ManpageFlags -> [String] -> Action-manpageAction commands flags extraArgs _ = do-  let verbosity = fromFlag (manpageVerbosity flags)-  unless (null extraArgs) $-    die' verbosity $ "'man' doesn't take any extra arguments: " ++ unwords extraArgs-  pname <- getProgName-  let cabalCmd = if takeExtension pname == ".exe"-                 then dropExtension pname-                 else pname-  manpageCmd cabalCmd commands flags+module Main (main) where++import Prelude ()+import Distribution.Client.Compat.Prelude++import System.Environment (getArgs)++import qualified Distribution.Client.Main as Client++main :: IO ()+main = getArgs >>= Client.main

@@ -106,7 +106,7 @@          ( configCompilerEx ) import Distribution.Simple.Compiler          ( Compiler(..), CompilerId(..), CompilerFlavor(..)-         , PackageDBStack )+         , PackageDBStack, PackageDB(..) ) import Distribution.Simple.GHC          ( ghcPlatformAndVersionString, getGhcAppDir          , GhcImplInfo(..), getImplInfo@@ -123,11 +123,13 @@ import Distribution.Simple.Utils          ( wrapText, die', notice, warn          , withTempDirectory, createDirectoryIfMissingVerbose-         , ordNub )+         , ordNub, safeHead ) import Distribution.Utils.Generic          ( writeFileAtomic )  import qualified Data.ByteString.Lazy.Char8 as BS+import Data.Ord+         ( Down(..) ) import qualified Data.Map as Map import qualified Data.Set as S import qualified Data.List.NonEmpty as NE@@ -424,7 +426,7 @@     unless dryRun $       if installLibs       then installLibraries verbosity-           buildCtx compiler packageDbs envFile nonGlobalEnvEntries'+           buildCtx installedIndex compiler packageDbs envFile nonGlobalEnvEntries'       else installExes verbosity            baseCtx buildCtx platform compiler configFlags clientInstallFlags   where@@ -687,20 +689,31 @@ installLibraries   :: Verbosity   -> ProjectBuildContext+  -> PI.PackageIndex InstalledPackageInfo   -> Compiler   -> PackageDBStack   -> FilePath -- ^ Environment file   -> [GhcEnvironmentFileEntry]   -> IO ()-installLibraries verbosity buildCtx compiler-                 packageDbs envFile envEntries = do+installLibraries verbosity buildCtx installedIndex compiler+                 packageDbs' envFile envEntries = do   if supportsPkgEnvFiles $ getImplInfo compiler     then do+      let validDb (SpecificPackageDB fp) = doesPathExist fp+          validDb _ = pure True+      -- if a user "installs" a global package and no existing cabal db exists, none will be created.+      -- this ensures we don't add the "phantom" path to the file.+      packageDbs <- filterM validDb packageDbs'       let+        getLatest = (=<<) (maybeToList . safeHead . snd) . take 1 . sortBy (comparing (Down . fst))+                  . PI.lookupPackageName installedIndex+        globalLatest = concat (getLatest <$> globalPackages)+        globalEntries = GhcEnvFilePackageId . installedUnitId <$> globalLatest         baseEntries =           GhcEnvFileClearPackageDbStack : fmap GhcEnvFilePackageDb packageDbs         pkgEntries = ordNub $-             envEntries+             globalEntries+          ++ envEntries           ++ entriesForLibraryComponents (targetsMap buildCtx)         contents' = renderGhcEnvironmentFile (baseEntries ++ pkgEntries)       createDirectoryIfMissing True (takeDirectory envFile)@@ -710,6 +723,12 @@           "The current compiler doesn't support safely installing libraries, "         ++ "so only executables will be available. (Library installation is "         ++ "supported on GHC 8.0+ only)"++-- See ticket #8894. This is safe to include any nonreinstallable boot pkg,+-- but the particular package users will always expect to be in scope without specific installation+-- is base, so that they can access prelude, regardles of if they specifically asked for it.+globalPackages :: [PackageName]+globalPackages = mkPackageName <$> [ "base" ]  warnIfNoExes :: Verbosity -> ProjectBuildContext -> IO () warnIfNoExes verbosity buildCtx =

@@ -28,7 +28,9 @@ import Distribution.Client.ProjectOrchestration import Distribution.Client.ProjectPlanning.Types import Distribution.Client.ScriptUtils-       (AcceptNoTargets(..), TargetContext(..), updateContextAndWriteProjectFile, withContextAndSelectors)+       ( AcceptNoTargets(..), TargetContext(..)+       , updateContextAndWriteProjectFile, withContextAndSelectors+       , movedExePath ) import Distribution.Client.Setup                 (GlobalFlags (..)) import Distribution.Client.TargetProblem         (TargetProblem (..)) import Distribution.Simple.BuildPaths            (dllExtension, exeExtension)@@ -170,7 +172,7 @@          bin_file c = case c of             CD.ComponentExe s-               | s == selectedComponent -> [bin_file' s]+               | s == selectedComponent -> [moved_bin_file s]             CD.ComponentTest s                | s == selectedComponent -> [bin_file' s]             CD.ComponentBench s@@ -193,6 +195,8 @@             if elabBuildStyle elab == BuildInplaceOnly             then dist_dir </> "build" </> prettyShow s </> ("lib" ++ prettyShow s) <.> dllExtension plat             else InstallDirs.bindir (elabInstallDirs elab) </> ("lib" ++ prettyShow s) <.> dllExtension plat++        moved_bin_file s = fromMaybe (bin_file' s) (movedExePath selectedComponent distDirLayout elaboratedSharedConfig elab)  ------------------------------------------------------------------------------- -- Target Problem: the very similar to CmdRun

@@ -22,49 +22,51 @@ import Prelude () import Distribution.Client.Compat.Prelude hiding (toList) -import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages          ( renderTargetSelector, showTargetSelector,            renderTargetProblem,            renderTargetProblemNoTargets, plural, targetSelectorPluralPkgs,            targetSelectorFilter, renderListCommaAnd,            renderListPretty )-import Distribution.Client.TargetProblem-         ( TargetProblem (..) )--import Distribution.Client.NixStyleOptions-         ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags )-import Distribution.Client.Setup-         ( GlobalFlags(..), ConfigFlags(..) ) import Distribution.Client.GlobalFlags          ( defaultGlobalFlags )-import Distribution.Simple.Flag-         ( fromFlagOrDefault )-import Distribution.Simple.Command-         ( CommandUI(..), usageAlternatives )-import Distribution.Types.ComponentName-         ( componentNameRaw )-import Distribution.Verbosity-         ( normal, silent )-import Distribution.Simple.Utils-         ( wrapText, die', info, notice, safeHead )+import Distribution.Client.InstallPlan+         ( toList, foldPlanPackage )+import Distribution.Client.NixStyleOptions+         ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags )+import Distribution.Client.ProjectOrchestration import Distribution.Client.ProjectPlanning          ( ElaboratedConfiguredPackage(..)          , ElaboratedInstallPlan, binDirectoryFor ) import Distribution.Client.ProjectPlanning.Types          ( dataDirsEnvironmentForPlan )-import Distribution.Client.InstallPlan-         ( toList, foldPlanPackage )-import Distribution.Types.UnqualComponentName-         ( UnqualComponentName, unUnqualComponentName )+import Distribution.Client.ScriptUtils+         ( AcceptNoTargets(..), TargetContext(..)+         , updateContextAndWriteProjectFile, withContextAndSelectors+         , movedExePath )+import Distribution.Client.Setup+         ( GlobalFlags(..), ConfigFlags(..) )+import Distribution.Client.TargetProblem+         ( TargetProblem (..) )+import Distribution.Simple.Command+         ( CommandUI(..), usageAlternatives )+import Distribution.Simple.Flag+         ( fromFlagOrDefault ) import Distribution.Simple.Program.Run          ( runProgramInvocation, ProgramInvocation(..),            emptyProgramInvocation )+import Distribution.Simple.Utils+         ( wrapText, die', info, notice, safeHead )+import Distribution.Types.ComponentName+         ( componentNameRaw ) import Distribution.Types.UnitId          ( UnitId )-import Distribution.Client.ScriptUtils-         ( AcceptNoTargets(..), withContextAndSelectors, updateContextAndWriteProjectFile, TargetContext(..) ) +import Distribution.Types.UnqualComponentName+         ( UnqualComponentName, unUnqualComponentName )+import Distribution.Verbosity+         ( normal, silent )+ import Data.List (group) import qualified Data.Set as Set import System.Directory@@ -216,11 +218,15 @@         ++ exeName         ++ ":\n"         ++ unlines (fmap (\p -> " - in package " ++ prettyShow (elabUnitId p)) elabPkgs)-    let exePath = binDirectoryFor (distDirLayout baseCtx)-                                  (elaboratedShared buildCtx)-                                  pkg-                                  exeName-               </> exeName++    let defaultExePath = binDirectoryFor+                            (distDirLayout baseCtx)+                            (elaboratedShared buildCtx)+                             pkg+                             exeName+                       </> exeName+        exePath = fromMaybe defaultExePath (movedExePath selectedComponent (distDirLayout baseCtx) (elaboratedShared buildCtx) pkg)+     let dryRun = buildSettingDryRun (buildSettings baseCtx)               || buildSettingOnlyDownload (buildSettings baseCtx) 

@@ -199,10 +199,12 @@       -- NB: always update the timestamp, even if we didn't actually       -- download anything       writeIndexTimestamp index indexState-      ce <- if repoContextIgnoreExpiry repoCtxt-              then Just `fmap` getCurrentTime-              else return Nothing-      updated <- Sec.uncheckClientErrors $ Sec.checkForUpdates repoSecure ce+      -- typically we get the current time to check expiry against+      -- but if the flag is set, we don't.+      now' <- case repoContextIgnoreExpiry repoCtxt of+                 False -> Just <$> getCurrentTime+                 True  -> pure Nothing+      updated <- Sec.uncheckClientErrors $ Sec.checkForUpdates repoSecure now'       -- this resolves indexState (which could be HEAD) into a timestamp       new_ts <- currentIndexTimestamp (lessVerbose verbosity) repoCtxt repo       let rname = remoteRepoName (repoRemote repo)

@@ -133,7 +133,7 @@ import Text.PrettyPrint.HughesPJ          ( text, Doc ) import System.Directory-         ( createDirectoryIfMissing, getHomeDirectory, getXdgDirectory, XdgDirectory(XdgCache, XdgConfig, XdgState), renameFile, getAppUserDataDirectory, doesDirectoryExist )+         ( createDirectoryIfMissing, getHomeDirectory, getXdgDirectory, XdgDirectory(XdgCache, XdgConfig, XdgState), renameFile, getAppUserDataDirectory, doesDirectoryExist, doesFileExist ) import Network.URI          ( URI(..), URIAuth(..), parseURI ) import System.FilePath@@ -568,34 +568,50 @@ -- initialSavedConfig :: IO SavedConfig initialSavedConfig = do-  cacheDir    <- defaultCacheDir-  logsDir     <- defaultLogsDir-  extraPath   <- defaultExtraPath+  cacheDir <- defaultCacheDir+  logsDir <- defaultLogsDir   installPath <- defaultInstallPath-  return mempty {-    savedGlobalFlags     = mempty {-      globalCacheDir     = toFlag cacheDir,-      globalRemoteRepos  = toNubList [defaultRemoteRepo]-    },-    savedConfigureFlags  = mempty {-      configProgramPathExtra = toNubList extraPath-    },-    savedInstallFlags    = mempty {-      installSummaryFile = toNubList [toPathTemplate (logsDir </> "build.log")],-      installBuildReports= toFlag NoReports,-      installNumJobs     = toFlag Nothing-    },-    savedClientInstallFlags = mempty {-      cinstInstalldir = toFlag installPath-    }-  }+  return+    mempty+      { savedGlobalFlags =+          mempty+            { globalCacheDir = toFlag cacheDir+            , globalRemoteRepos = toNubList [defaultRemoteRepo]+            }+      , savedInstallFlags =+          mempty+            { installSummaryFile = toNubList [toPathTemplate (logsDir </> "build.log")]+            , installBuildReports = toFlag NoReports+            , installNumJobs = toFlag Nothing+            }+      , savedClientInstallFlags =+          mempty+            { cinstInstalldir = toFlag installPath+            }+      } --- | If @CABAL\_DIR@ is set or @~/.cabal@ exists, return that--- directory.  Otherwise returns Nothing.  If this function returns--- Nothing, then it implies that we are not using a single directory--- for everything, but instead use XDG paths.  Fundamentally, this--- function is used to implement transparent backwards compatibility--- with pre-XDG versions of cabal-install.+-- | Issue a warning if both @$XDG_CONFIG_HOME/cabal/config@ and+-- @~/.cabal@ exists.+warnOnTwoConfigs :: Verbosity -> IO ()+warnOnTwoConfigs verbosity = do+  defaultDir <- getAppUserDataDirectory "cabal"+  dotCabalExists <- doesDirectoryExist defaultDir+  xdgCfg <- getXdgDirectory XdgConfig ("cabal" </> "config")+  xdgCfgExists <- doesFileExist xdgCfg+  when (dotCabalExists && xdgCfgExists) $+    warn verbosity $+    "Both " <> defaultDir <>+    " and " <> xdgCfg <>+    " exist - ignoring the former.\n" <>+    "It is advisable to remove one of them. In that case, we will use the remaining one by default (unless '$CABAL_DIR' is explicitly set)."++-- | If @CABAL\_DIR@ is set, return @Just@ its value. Otherwise, if+-- @~/.cabal@ exists and @$XDG_CONFIG_HOME/cabal/config@ does not+-- exist, return @Just "~/.cabal"@.  Otherwise, return @Nothing@.  If+-- this function returns Nothing, then it implies that we are not+-- using a single directory for everything, but instead use XDG paths.+-- Fundamentally, this function is used to implement transparent+-- backwards compatibility with pre-XDG versions of cabal-install. maybeGetCabalDir :: IO (Maybe FilePath) maybeGetCabalDir = do   mDir <- lookupEnv "CABAL_DIR"@@ -604,9 +620,11 @@     Nothing -> do       defaultDir <- getAppUserDataDirectory "cabal"       dotCabalExists <- doesDirectoryExist defaultDir-      return $ if dotCabalExists-               then Just defaultDir-               else Nothing+      xdgCfg <- getXdgDirectory XdgConfig ("cabal" </> "config")+      xdgCfgExists <- doesFileExist xdgCfg+      if dotCabalExists && not xdgCfgExists+        then return $ Just defaultDir+        else return Nothing  -- | The default behaviour of cabal-install is to use the XDG -- directory standard.  However, if @CABAL_DIR@ is set, we instead use@@ -656,16 +674,6 @@ defaultReportsDir =   getDefaultDir XdgCache "reports" -defaultExtraPath :: IO [FilePath]-defaultExtraPath = do-  mDir <- maybeGetCabalDir-  case mDir of-    Just dir ->-      return [dir </> "bin"]-    Nothing -> do-      dir <- getHomeDirectory-      return [dir </> ".local" </> "bin"]- defaultInstallPath :: IO FilePath defaultInstallPath = do   mDir <- maybeGetCabalDir@@ -737,12 +745,29 @@ -- defaultHackageRemoteRepoKeys :: [String] defaultHackageRemoteRepoKeys =-    [ "fe331502606802feac15e514d9b9ea83fee8b6ffef71335479a2e68d84adc6b0",-      "1ea9ba32c526d1cc91ab5e5bd364ec5e9e8cb67179a471872f6e26f0ae773d42",-      "2c6c3627bd6c982990239487f1abd02e08a02e6cf16edb105a8012d444d870c3",-      "0a5c7ea47cd1b15f01f5f51a33adda7e655bc0f0b0615baa8e271f4c3351e21d",-      "51f0161b906011b52c6613376b1ae937670da69322113a246a09f807c62f6921"-    ]+  -- Key owners and public keys are provided as a convenience to readers.+  -- The canonical source for this mapping data is the hackage-root-keys+  -- repository and Hackage's root.json file.+  --+  -- Links:+  --  * https://github.com/haskell-infra/hackage-root-keys+  --  * https://hackage.haskell.org/root.json+  -- Please consult root.json on Hackage to map key IDs to public keys,+  -- and the hackage-root-keys repository to map public keys to their+  -- owners.+  [ -- Adam Gundry (uRPdSiL3/MNsk50z6NB55ABo0OrrNDXigtCul4vtzmw=)+    "fe331502606802feac15e514d9b9ea83fee8b6ffef71335479a2e68d84adc6b0"+  , -- Gershom Bazerman (bYoUXXQ9TtX10UriaMiQtTccuXPGnmldP68djzZ7cLo=)+    "1ea9ba32c526d1cc91ab5e5bd364ec5e9e8cb67179a471872f6e26f0ae773d42"+  , -- John Wiegley (zazm5w480r+zPO6Z0+8fjGuxZtb9pAuoVmQ+VkuCvgU=)+    "0a5c7ea47cd1b15f01f5f51a33adda7e655bc0f0b0615baa8e271f4c3351e21d"+  , -- Norman Ramsey (ZI8di3a9Un0s2RBrt5GwVRvfOXVuywADfXGPZfkiDb0=)+    "51f0161b906011b52c6613376b1ae937670da69322113a246a09f807c62f6921"+  , -- Mathieu Boespflug (ydN1nGGQ79K1Q0nN+ul+Ln8MxikTB95w0YdGd3v3kmg=)+    "be75553f3c7ba1dbe298da81f1d1b05c9d39dd8ed2616c9bddf1525ca8c03e48"+  , -- Joachim Breitner (5iUgwqZCWrCJktqMx0bBMIuoIyT4A1RYGozzchRN9rA=)+    "d26e46f3b631aae1433b89379a6c68bd417eb5d1c408f0643dcc07757fece522"+  ]  -- | The required threshold of root key signatures for hackage.haskell.org --@@ -759,6 +784,7 @@ -- loadConfig :: Verbosity -> Flag FilePath -> IO SavedConfig loadConfig verbosity configFileFlag = do+  warnOnTwoConfigs verbosity   config <- loadRawConfig verbosity configFileFlag   extendToEffectiveConfig config @@ -900,7 +926,8 @@   globalInstallDirs <- defaultInstallDirs defaultCompiler False True   let conf0 = mempty {         savedGlobalFlags       = defaultGlobalFlags {-            globalRemoteRepos = toNubList [defaultRemoteRepo]+            globalRemoteRepos = toNubList [defaultRemoteRepo],+            globalNix         = mempty             },         savedInitFlags       = mempty {             IT.interactive     = toFlag False,

@@ -397,24 +397,50 @@       | Set.notMember (mkPackageName "base") (depResolverTargets params)       -- If you change this enumeration, make sure to update the list in       -- "Distribution.Solver.Modular.Solver" as well-      , pkgname <- [ mkPackageName "base"-                   , mkPackageName "ghc-bignum"-                   , mkPackageName "ghc-prim"-                   , mkPackageName "ghc-boot"-                   , mkPackageName "ghc"-                   , mkPackageName "ghci"-                   , mkPackageName "integer-gmp"-                   , mkPackageName "integer-simple"-                   , mkPackageName "template-haskell"-                   ]+      , pkgname <- nonUpgradeablePackages       , isInstalled pkgname ]      isInstalled = not . null                 . InstalledPackageIndex.lookupPackageName                                  (depResolverInstalledPkgIndex params) -addSourcePackages :: [UnresolvedSourcePackage]-                  -> DepResolverParams -> DepResolverParams+-- | The set of non-reinstallable packages includes those which cannot be+-- rebuilt using a GHC installation and Hackage-published source distribution.+-- There are a few reasons why this might be true:+--+--  * the package overrides its unit ID (e.g. with ghc's @-this-unit-id@ flag),+--    which can result in multiple indistinguishable packages (having potentially+--    different ABIs) with the same unit ID.+--+--  * the package contains definitions of wired-in declarations which tie+--    it to a particular compiler (e.g. we can't build link against+--    @base-4.18.0.0@ using GHC 9.6.1).+--+--  * the package does not have a complete (that is, buildable) source distribution.+--    For instance, some packages provided by GHC rely on files outside of the+--    source tree generated by GHC's build system.+--+-- Note: the list of non-upgradable/non-installable packages used to be+-- respectively in this module and in `Distribution.Solver.Modular.Solver`.+-- Since they were kept synced, they are now combined in the following list.+--+-- See: https://github.com/haskell/cabal/issues/8581 and+-- https://github.com/haskell/cabal/issues/9064.+nonUpgradeablePackages :: [PackageName]+nonUpgradeablePackages =+  [ mkPackageName "base"+  , mkPackageName "ghc-bignum"+  , mkPackageName "ghc-prim"+  , mkPackageName "ghc"+  , mkPackageName "integer-gmp"+  , mkPackageName "integer-simple"+  , mkPackageName "template-haskell"+  ]++addSourcePackages+  :: [UnresolvedSourcePackage]+  -> DepResolverParams+  -> DepResolverParams addSourcePackages pkgs params =     params {       depResolverSourcePkgIndex =

@@ -6,6 +6,7 @@     hashValue,     truncateHash,     showHashValue,+    showHashValueBase64,     readFileHashValue,     hashFromTUF,     ) where@@ -17,6 +18,7 @@  import qualified Crypto.Hash.SHA256         as SHA256 import qualified Data.ByteString.Base16     as Base16+import qualified Data.ByteString.Base64     as Base64 import qualified Data.ByteString.Char8      as BS import qualified Data.ByteString.Lazy.Char8 as LBS @@ -54,6 +56,9 @@  showHashValue :: HashValue -> String showHashValue (HashValue digest) = BS.unpack (Base16.encode digest)++showHashValueBase64 :: HashValue -> String+showHashValueBase64 (HashValue digest) = BS.unpack (Base64.encode digest)  -- | Hash the content of a file. Uses SHA256. --

@@ -356,14 +356,10 @@       else fmap prettyShow knownLicenses  authorPrompt :: Interactive m => InitFlags -> m String-authorPrompt flags = getAuthor flags $ do-    name <- guessAuthorName-    promptStr "Author name" (DefaultPrompt name)+authorPrompt flags = getAuthor flags $ guessAuthorName >>= promptOrDefault "Author name"  emailPrompt :: Interactive m => InitFlags -> m String-emailPrompt flags = getEmail flags $ do-    email' <- guessAuthorEmail-    promptStr "Maintainer email" (DefaultPrompt email')+emailPrompt flags = getEmail flags $ guessAuthorEmail >>= promptOrDefault "Maintainer email"  homepagePrompt :: Interactive m => InitFlags -> m String homepagePrompt flags = getHomepage flags $@@ -468,3 +464,6 @@       True      return [dir]++promptOrDefault :: Interactive m => String -> Maybe String -> m String+promptOrDefault s = maybe (promptStr s MandatoryPrompt)  (promptStr s . DefaultPrompt)

@@ -274,14 +274,16 @@ licenseHeuristics flags = getLicense flags $ guessLicense flags  -- | The author's name. Prompt, or try to guess from an existing---   darcs repo.+--   git repo. authorHeuristics :: Interactive m => InitFlags -> m String-authorHeuristics flags = getAuthor flags guessAuthorEmail+authorHeuristics flags = guessAuthorName >>=+  maybe (getAuthor flags $ return "Unknown") (getAuthor flags . return)  -- | The author's email. Prompt, or try to guess from an existing---   darcs repo.+--   git repo. emailHeuristics :: Interactive m => InitFlags -> m String-emailHeuristics flags = getEmail flags guessAuthorName+emailHeuristics flags = guessAuthorEmail >>=+  maybe (getEmail flags $ return "Unknown") (getEmail flags . return)  -- | Prompt for a homepage URL for the package. homepageHeuristics :: Interactive m => InitFlags -> m String

@@ -151,18 +151,23 @@     True  -> ["src"]  -- | Guess author and email using git configuration options.-guessAuthorName :: Interactive m => m String+guessAuthorName :: Interactive m => m (Maybe String) guessAuthorName = guessGitInfo "user.name" -guessAuthorEmail :: Interactive m => m String+guessAuthorEmail :: Interactive m => m (Maybe String) guessAuthorEmail = guessGitInfo "user.email" -guessGitInfo :: Interactive m => String -> m String+guessGitInfo :: Interactive m => String -> m (Maybe String) guessGitInfo target = do-  info <- readProcessWithExitCode "git" ["config", "--local", target] ""-  if null $ snd' info-    then trim . snd' <$> readProcessWithExitCode "git" ["config", "--global", target] ""-    else return . trim $ snd' info+  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

@@ -0,0 +1,1013 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Main+-- Copyright   :  (c) David Himmelstrup 2005+-- License     :  BSD-like+--+-- Maintainer  :  lemmih@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Entry point to the default cabal-install front-end.+--+-- @since 3.10.0.0+-----------------------------------------------------------------------------++module Distribution.Client.Main (main) where++import Distribution.Client.Setup+         ( GlobalFlags(..), globalCommand, withRepoContext+         , ConfigFlags(..)+         , ConfigExFlags(..), defaultConfigExFlags, configureExCommand+         , reconfigureCommand+         , configCompilerAux', configPackageDB'+         , BuildFlags(..)+         , buildCommand, replCommand, testCommand, benchmarkCommand+         , InstallFlags(..), defaultInstallFlags+         , installCommand+         , FetchFlags(..), fetchCommand+         , FreezeFlags(..), freezeCommand+         , genBoundsCommand+         , GetFlags(..), getCommand, unpackCommand+         , checkCommand+         , formatCommand+         , ListFlags(..), listCommand, listNeedsCompiler+         , InfoFlags(..), infoCommand+         , UploadFlags(..), uploadCommand+         , ReportFlags(..), reportCommand+         , runCommand+         , InitFlags(initVerbosity, initHcPath), initCommand+         , ActAsSetupFlags(..), actAsSetupCommand+         , UserConfigFlags(..), userConfigCommand+         , reportCommand+         , manpageCommand+         , haddockCommand+         , cleanCommand+         , copyCommand+         , registerCommand+         )+import Distribution.Simple.Setup+         ( HaddockTarget(..)+         , HaddockFlags(..), defaultHaddockFlags+         , HscolourFlags(..), hscolourCommand+         , ReplFlags(..)+         , CopyFlags(..)+         , RegisterFlags(..)+         , CleanFlags(..)+         , TestFlags(..), BenchmarkFlags(..)+         , Flag(..), fromFlag, fromFlagOrDefault, flagToMaybe, toFlag+         , configAbsolutePaths+         )++import Prelude ()+import Distribution.Client.Compat.Prelude hiding (get)++import Distribution.Client.SetupWrapper+         ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )+import Distribution.Client.Config+         ( SavedConfig(..), loadConfig, defaultConfigFile, userConfigDiff+         , userConfigUpdate, createDefaultConfigFile, getConfigFilePath )+import Distribution.Client.Targets+         ( readUserTargets )+import qualified Distribution.Client.List as List+         ( list, info )++import qualified Distribution.Client.CmdConfigure as CmdConfigure+import qualified Distribution.Client.CmdUpdate    as CmdUpdate+import qualified Distribution.Client.CmdBuild     as CmdBuild+import qualified Distribution.Client.CmdRepl      as CmdRepl+import qualified Distribution.Client.CmdFreeze    as CmdFreeze+import qualified Distribution.Client.CmdHaddock   as CmdHaddock+import qualified Distribution.Client.CmdHaddockProject as CmdHaddockProject+import qualified Distribution.Client.CmdInstall   as CmdInstall+import qualified Distribution.Client.CmdRun       as CmdRun+import qualified Distribution.Client.CmdTest      as CmdTest+import qualified Distribution.Client.CmdBench     as CmdBench+import qualified Distribution.Client.CmdExec      as CmdExec+import qualified Distribution.Client.CmdClean     as CmdClean+import qualified Distribution.Client.CmdSdist     as CmdSdist+import qualified Distribution.Client.CmdListBin   as CmdListBin+import qualified Distribution.Client.CmdOutdated  as CmdOutdated+import           Distribution.Client.CmdLegacy++import Distribution.Client.Install            (install)+import Distribution.Client.Configure          (configure, writeConfigFlags)+import Distribution.Client.Fetch              (fetch)+import Distribution.Client.Freeze             (freeze)+import Distribution.Client.GenBounds          (genBounds)+import Distribution.Client.Check as Check     (check)+--import Distribution.Client.Clean            (clean)+import qualified Distribution.Client.Upload as Upload+import Distribution.Client.Run                (run, splitRunArgs)+import Distribution.Client.Get                (get)+import Distribution.Client.Reconfigure        (Check(..), reconfigure)+import Distribution.Client.Nix                (nixInstantiate+                                              ,nixShell+                                              )+import Distribution.Client.Sandbox            (loadConfigOrSandboxConfig+                                              ,findSavedDistPref+                                              ,updateInstallDirs)+import Distribution.Client.Tar                (createTarGzFile)+import Distribution.Client.Types.Credentials  (Password (..))+import Distribution.Client.Init               (initCmd)+import Distribution.Client.Manpage            (manpageCmd)+import Distribution.Client.ManpageFlags       (ManpageFlags (..))+import Distribution.Client.Utils+         ( determineNumJobs, relaxEncodingErrors )+import Distribution.Client.Signal+         ( installTerminationHandler )+import Distribution.Client.Version+         ( cabalInstallVersion )++import Distribution.Package (packageId)+import Distribution.PackageDescription+         ( BuildType(..), Executable(..), buildable )++import Distribution.PackageDescription.PrettyPrint+         ( writeGenericPackageDescription )+import qualified Distribution.Simple as Simple+import qualified Distribution.Make as Make+import qualified Distribution.Types.UnqualComponentName as Make+import Distribution.Simple.Build+         ( startInterpreter )+import Distribution.Simple.Command+         ( CommandParse(..), CommandUI(..), Command, CommandSpec(..)+         , CommandType(..), commandsRun, commandAddAction, hiddenCommand+         , commandFromSpec, commandShowOptions )+import Distribution.Simple.Compiler (PackageDBStack)+import Distribution.Simple.Configure+         ( configCompilerAuxEx, ConfigStateFileError(..)+         , getPersistBuildConfig, interpretPackageDbFlags+         , tryGetPersistBuildConfig )+import qualified Distribution.Simple.LocalBuildInfo as LBI+import Distribution.Simple.PackageDescription ( readGenericPackageDescription )+import Distribution.Simple.Program (defaultProgramDb+                                   ,configureAllKnownPrograms+                                   ,simpleProgramInvocation+                                   ,getProgramInvocationOutput)+import Distribution.Simple.Program.Db (reconfigurePrograms)+import qualified Distribution.Simple.Setup as Cabal+import Distribution.Simple.Utils+         ( cabalVersion, die', dieNoVerbosity, info, notice, topHandler+         , findPackageDesc, tryFindPackageDesc, createDirectoryIfMissingVerbose )+import Distribution.Text+         ( display )+import Distribution.Verbosity as Verbosity+         ( normal )+import Distribution.Version+         ( Version, mkVersion, orLaterVersion )++import Distribution.Compat.ResponseFile+import System.Environment       (getProgName)+import System.FilePath          ( dropExtension, splitExtension+                                , takeExtension, (</>), (<.>) )+import System.IO                ( BufferMode(LineBuffering), hSetBuffering+                                , hPutStrLn, stderr, stdout )+import System.Directory         ( doesFileExist, getCurrentDirectory+                                , withCurrentDirectory)+import Data.Monoid              (Any(..))+import Control.Exception        (AssertionFailed, assert, try)+++-- | Entry point+--+main :: [String] -> IO ()+main args = do+  installTerminationHandler+  -- Enable line buffering so that we can get fast feedback even when piped.+  -- This is especially important for CI and build systems.+  hSetBuffering stdout LineBuffering++  -- If the locale encoding for CLI doesn't support all Unicode characters,+  -- printing to it may fail unless we relax the handling of encoding errors+  -- when writing to stderr and stdout.+  relaxEncodingErrors stdout+  relaxEncodingErrors stderr+  let (args0, args1) = break (== "--") args++  mainWorker =<< (++ args1) <$> expandResponse args0++-- | Check whether assertions are enabled and print a warning in that case.+warnIfAssertionsAreEnabled :: IO ()+warnIfAssertionsAreEnabled =+  assert False (return ()) `catch`+  (\(_e :: AssertionFailed) -> hPutStrLn stderr assertionsEnabledMsg)+    -- Andreas, 2022-12-30, issue #8654:+    -- The verbosity machinery is not in place at this point (option -v not parsed),+    -- so instead of using function @warn@, we print straight to stderr.+  where+    assertionsEnabledMsg =+      "Warning: this is a debug build of cabal-install with assertions enabled."++mainWorker :: [String] -> IO ()+mainWorker args = do+  topHandler $+    case commandsRun (globalCommand commands) commands args of+      CommandHelp   help                 -> printGlobalHelp help+      CommandList   opts                 -> printOptionsList opts+      CommandErrors errs                 -> printErrors errs+      CommandReadyToGo (globalFlags, commandParse)  ->+        case commandParse of+          _ | fromFlagOrDefault False (globalVersion globalFlags)+              -> printVersion+            | fromFlagOrDefault False (globalNumericVersion globalFlags)+              -> printNumericVersion+          CommandHelp     help           -> printCommandHelp help+          CommandList     opts           -> printOptionsList opts++          CommandErrors   errs           -> do+            -- Check whether cabal is called from a script, like #!/path/to/cabal.+            case args of+              []      -> printErrors errs+              script : scriptArgs -> CmdRun.validScript script >>= \case+                False -> printErrors errs+                True  -> do+                  -- In main operation (not help, version etc.) print warning if assertions are on.+                  warnIfAssertionsAreEnabled+                  CmdRun.handleShebang script scriptArgs++          CommandReadyToGo action        -> do+            -- In main operation (not help, version etc.) print warning if assertions are on.+            warnIfAssertionsAreEnabled+            action globalFlags++  where+    printCommandHelp help = do+      pname <- getProgName+      putStr (help pname)+    printGlobalHelp help = do+      pname <- getProgName+      configFile <- defaultConfigFile+      putStr (help pname)+      putStr $ "\nYou can edit the cabal configuration file to set defaults:\n"+            ++ "  " ++ configFile ++ "\n"+      exists <- doesFileExist configFile+      unless exists $+          putStrLn $ "This file will be generated with sensible "+                  ++ "defaults if you run 'cabal update'."+    printOptionsList = putStr . unlines+    printErrors errs = dieNoVerbosity $ intercalate "\n" errs+    printNumericVersion = putStrLn $ display cabalInstallVersion+    printVersion        = putStrLn $ "cabal-install version "+                                  ++ display cabalInstallVersion+                                  ++ "\ncompiled using version "+                                  ++ display cabalVersion+                                  ++ " of the Cabal library "++    commands = map commandFromSpec commandSpecs+    commandSpecs =+      [ regularCmd listCommand listAction+      , regularCmd infoCommand infoAction+      , regularCmd fetchCommand fetchAction+      , regularCmd getCommand getAction+      , regularCmd unpackCommand unpackAction+      , regularCmd checkCommand checkAction+      , regularCmd uploadCommand uploadAction+      , regularCmd reportCommand reportAction+      , regularCmd initCommand initAction+      , regularCmd userConfigCommand userConfigAction+      , regularCmd genBoundsCommand genBoundsAction+      , regularCmd CmdOutdated.outdatedCommand CmdOutdated.outdatedAction+      , wrapperCmd hscolourCommand hscolourVerbosity hscolourDistPref+      , hiddenCmd  formatCommand formatAction+      , hiddenCmd  actAsSetupCommand actAsSetupAction+      , hiddenCmd  manpageCommand (manpageAction commandSpecs)+      , regularCmd CmdListBin.listbinCommand     CmdListBin.listbinAction++      ] ++ concat+      [ newCmd  CmdConfigure.configureCommand CmdConfigure.configureAction+      , newCmd  CmdUpdate.updateCommand       CmdUpdate.updateAction+      , newCmd  CmdBuild.buildCommand         CmdBuild.buildAction+      , newCmd  CmdRepl.replCommand           CmdRepl.replAction+      , newCmd  CmdFreeze.freezeCommand       CmdFreeze.freezeAction+      , newCmd  CmdHaddock.haddockCommand     CmdHaddock.haddockAction+      , newCmd  CmdHaddockProject.haddockProjectCommand+                                              CmdHaddockProject.haddockProjectAction+      , newCmd  CmdInstall.installCommand     CmdInstall.installAction+      , newCmd  CmdRun.runCommand             CmdRun.runAction+      , newCmd  CmdTest.testCommand           CmdTest.testAction+      , newCmd  CmdBench.benchCommand         CmdBench.benchAction+      , newCmd  CmdExec.execCommand           CmdExec.execAction+      , newCmd  CmdClean.cleanCommand         CmdClean.cleanAction+      , newCmd  CmdSdist.sdistCommand         CmdSdist.sdistAction++      , legacyCmd configureExCommand configureAction+      , legacyCmd buildCommand buildAction+      , legacyCmd replCommand replAction+      , legacyCmd freezeCommand freezeAction+      , legacyCmd haddockCommand haddockAction+      , legacyCmd installCommand installAction+      , legacyCmd runCommand runAction+      , legacyCmd testCommand testAction+      , legacyCmd benchmarkCommand benchmarkAction+      , legacyCmd cleanCommand cleanAction+      , legacyWrapperCmd copyCommand copyVerbosity copyDistPref+      , legacyWrapperCmd registerCommand regVerbosity regDistPref+      , legacyCmd reconfigureCommand reconfigureAction+      ]++type Action = GlobalFlags -> IO ()++-- Duplicated in Distribution.Client.CmdLegacy. Any changes must be+-- reflected there, as well.+regularCmd :: CommandUI flags -> (flags -> [String] -> action)+           -> CommandSpec action+regularCmd ui action =+  CommandSpec ui ((flip commandAddAction) action) NormalCommand++hiddenCmd :: CommandUI flags -> (flags -> [String] -> action)+          -> CommandSpec action+hiddenCmd ui action =+  CommandSpec ui (\ui' -> hiddenCommand (commandAddAction ui' action))+  HiddenCommand++wrapperCmd :: Monoid flags => CommandUI flags -> (flags -> Flag Verbosity)+           -> (flags -> Flag String) -> CommandSpec Action+wrapperCmd ui verbosity distPref =+  CommandSpec ui (\ui' -> wrapperAction ui' verbosity distPref) NormalCommand++wrapperAction :: Monoid flags+              => CommandUI flags+              -> (flags -> Flag Verbosity)+              -> (flags -> Flag String)+              -> Command Action+wrapperAction command verbosityFlag distPrefFlag =+  commandAddAction command+    { commandDefaultFlags = mempty } $ \flags extraArgs globalFlags -> do+    let verbosity = fromFlagOrDefault normal (verbosityFlag flags)+    load <- try (loadConfigOrSandboxConfig verbosity globalFlags)+    let config = either (\(SomeException _) -> mempty) id load+    distPref <- findSavedDistPref config (distPrefFlag flags)+    let setupScriptOptions = defaultSetupScriptOptions { useDistPref = distPref }+    setupWrapper verbosity setupScriptOptions Nothing+                 command (const flags) (const extraArgs)++configureAction :: (ConfigFlags, ConfigExFlags)+                -> [String] -> Action+configureAction (configFlags, configExFlags) extraArgs globalFlags = do+  let verbosity = fromFlagOrDefault normal (configVerbosity configFlags)+  config <- updateInstallDirs (configUserInstall configFlags)+                          <$> loadConfigOrSandboxConfig verbosity globalFlags+  distPref <- findSavedDistPref config (configDistPref configFlags)+  nixInstantiate verbosity distPref True globalFlags config+  nixShell verbosity distPref globalFlags config $ do+    let configFlags'   = savedConfigureFlags   config `mappend` configFlags+        configExFlags' = savedConfigureExFlags config `mappend` configExFlags+        globalFlags'   = savedGlobalFlags      config `mappend` globalFlags+    (comp, platform, progdb) <- configCompilerAuxEx configFlags'++    writeConfigFlags verbosity distPref (configFlags', configExFlags')++    -- What package database(s) to use+    let packageDBs :: PackageDBStack+        packageDBs+          = interpretPackageDbFlags+            (fromFlag (configUserInstall configFlags'))+            (configPackageDBs configFlags')++    withRepoContext verbosity globalFlags' $ \repoContext ->+        configure verbosity packageDBs repoContext+                  comp platform progdb configFlags' configExFlags' extraArgs++reconfigureAction :: (ConfigFlags, ConfigExFlags)+                  -> [String] -> Action+reconfigureAction flags@(configFlags, _) _ globalFlags = do+  let verbosity = fromFlagOrDefault normal (configVerbosity configFlags)+  config <- updateInstallDirs (configUserInstall configFlags)+                          <$> loadConfigOrSandboxConfig verbosity globalFlags+  distPref <- findSavedDistPref config (configDistPref configFlags)+  let checkFlags = Check $ \_ saved -> do+        let flags' = saved <> flags+        unless (saved == flags') $ info verbosity message+        pure (Any True, flags')+        where+          -- This message is correct, but not very specific: it will list all+          -- of the new flags, even if some have not actually changed. The+          -- *minimal* set of changes is more difficult to determine.+          message =+            "flags changed: "+            ++ unwords (commandShowOptions configureExCommand flags)+  nixInstantiate verbosity distPref True globalFlags config+  _ <-+    reconfigure configureAction+    verbosity distPref NoFlag+    checkFlags [] globalFlags config+  pure ()++buildAction :: BuildFlags -> [String] -> Action+buildAction buildFlags extraArgs globalFlags = do+  let verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags)+  config <- loadConfigOrSandboxConfig verbosity globalFlags+  distPref <- findSavedDistPref config (buildDistPref buildFlags)+  -- Calls 'configureAction' to do the real work, so nothing special has to be+  -- done to support sandboxes.+  config' <-+    reconfigure configureAction+    verbosity distPref (buildNumJobs buildFlags)+    mempty [] globalFlags config+  nixShell verbosity 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 config distPref buildFlags extraArgs =+  setupWrapper verbosity setupOptions Nothing+               (Cabal.buildCommand progDb) mkBuildFlags (const extraArgs)+  where+    progDb       = defaultProgramDb+    setupOptions = defaultSetupScriptOptions { useDistPref = distPref }++    mkBuildFlags version = filterBuildFlags version config buildFlags'+    buildFlags' = buildFlags+      { buildVerbosity = toFlag verbosity+      , buildDistPref  = 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+  | version >= mkVersion [1,19,1] = buildFlags_latest+  -- Cabal < 1.19.1 doesn't support 'build -j'.+  | otherwise                      = buildFlags_pre_1_19_1+  where+    buildFlags_pre_1_19_1 = buildFlags {+      buildNumJobs = NoFlag+      }+    buildFlags_latest     = buildFlags {+      -- Take the 'jobs' setting config file into account.+      buildNumJobs = Flag . Just . determineNumJobs $+                     (numJobsConfigFlag `mappend` numJobsCmdLineFlag)+      }+    numJobsConfigFlag  = installNumJobs . savedInstallFlags $ config+    numJobsCmdLineFlag = buildNumJobs buildFlags+++replAction :: ReplFlags -> [String] -> Action+replAction replFlags extraArgs globalFlags = do+  let verbosity = fromFlagOrDefault normal (replVerbosity replFlags)+  config <- loadConfigOrSandboxConfig verbosity globalFlags+  distPref <- findSavedDistPref config (replDistPref replFlags)+  cwd     <- getCurrentDirectory+  pkgDesc <- findPackageDesc cwd+  let+    -- There is a .cabal file in the current directory: start a REPL and load+    -- the project's modules.+    onPkgDesc = do+      -- Calls 'configureAction' to do the real work, so nothing special has to+      -- be done to support sandboxes.+      _ <-+        reconfigure configureAction+        verbosity distPref NoFlag+        mempty [] globalFlags config+      let progDb = defaultProgramDb+          setupOptions = defaultSetupScriptOptions+            { useCabalVersion = orLaterVersion $ mkVersion [1,18,0]+            , useDistPref     = distPref+            }+          replFlags'   = replFlags+            { replVerbosity = toFlag verbosity+            , replDistPref  = toFlag distPref+            }++      nixShell verbosity distPref globalFlags config $+        setupWrapper verbosity setupOptions Nothing (Cabal.replCommand progDb) (const replFlags') (const extraArgs)++    -- No .cabal file in the current directory: just start the REPL (possibly+    -- using the sandbox package DB).+    onNoPkgDesc = do+      let configFlags = savedConfigureFlags config+      (comp, platform, programDb) <- configCompilerAux' configFlags+      programDb' <- reconfigurePrograms verbosity+                                        (replProgramPaths replFlags)+                                        (replProgramArgs replFlags)+                                        programDb+      nixShell verbosity distPref globalFlags config $ do+        startInterpreter verbosity programDb' comp platform+                        (configPackageDB' configFlags)++  either (const onNoPkgDesc) (const onPkgDesc) pkgDesc++installAction :: ( ConfigFlags, ConfigExFlags, InstallFlags+                 , HaddockFlags, TestFlags, BenchmarkFlags )+              -> [String] -> Action+installAction (configFlags, _, installFlags, _, _, _) _ globalFlags+  | fromFlagOrDefault False (installOnly installFlags) = do+      let verb = fromFlagOrDefault normal (configVerbosity configFlags)+      config <- loadConfigOrSandboxConfig verb globalFlags+      dist <- findSavedDistPref config (configDistPref configFlags)+      let setupOpts = defaultSetupScriptOptions { useDistPref = dist }+      setupWrapper+        verb setupOpts Nothing+        installCommand (const (mempty, mempty, mempty, mempty, mempty, mempty))+                       (const [])++installAction+  ( configFlags, configExFlags, installFlags+  , haddockFlags, testFlags, benchmarkFlags )+  extraArgs globalFlags = do+  let verb = fromFlagOrDefault normal (configVerbosity configFlags)+  config <- updateInstallDirs (configUserInstall configFlags)+                          <$> loadConfigOrSandboxConfig verb globalFlags++  dist <- findSavedDistPref config (configDistPref configFlags)++  do+    targets <- readUserTargets verb extraArgs++    let configFlags'    = maybeForceTests installFlags' $+                          savedConfigureFlags   config `mappend`+                          configFlags { configDistPref = toFlag dist }+        configExFlags'  = defaultConfigExFlags         `mappend`+                          savedConfigureExFlags config `mappend` configExFlags+        installFlags'   = defaultInstallFlags          `mappend`+                          savedInstallFlags     config `mappend` installFlags+        haddockFlags'   = defaultHaddockFlags          `mappend`+                          savedHaddockFlags     config `mappend`+                          haddockFlags { haddockDistPref = toFlag dist }+        testFlags'      = Cabal.defaultTestFlags       `mappend`+                          savedTestFlags        config `mappend`+                          testFlags { testDistPref = toFlag dist }+        benchmarkFlags' = Cabal.defaultBenchmarkFlags  `mappend`+                          savedBenchmarkFlags   config `mappend`+                          benchmarkFlags { benchmarkDistPref = toFlag dist }+        globalFlags'    = savedGlobalFlags      config `mappend` globalFlags+    (comp, platform, progdb) <- configCompilerAux' configFlags'++    -- TODO: Redesign ProgramDB API to prevent such problems as #2241 in the+    -- future.+    progdb' <- configureAllKnownPrograms verb progdb++    configFlags'' <- configAbsolutePaths configFlags'++    withRepoContext verb globalFlags' $ \repoContext ->+        install verb+                (configPackageDB' configFlags'')+                repoContext+                comp platform progdb'+                globalFlags' configFlags'' configExFlags'+                installFlags' haddockFlags' testFlags' benchmarkFlags'+                targets++      where+        -- '--run-tests' implies '--enable-tests'.+        maybeForceTests installFlags' configFlags' =+          if fromFlagOrDefault False (installRunTests installFlags')+          then configFlags' { configTests = toFlag True }+          else configFlags'++testAction :: (BuildFlags, TestFlags) -> [String] -> GlobalFlags+           -> IO ()+testAction (buildFlags, testFlags) extraArgs globalFlags = do+  let verbosity      = fromFlagOrDefault normal (buildVerbosity buildFlags)+  config <- loadConfigOrSandboxConfig verbosity globalFlags+  distPref <- findSavedDistPref config (testDistPref testFlags)+  let buildFlags'    = buildFlags+                      { buildVerbosity = testVerbosity testFlags }+      checkFlags = Check $ \_ flags@(configFlags, configExFlags) ->+        if fromFlagOrDefault False (configTests configFlags)+          then pure (mempty, flags)+          else do+            info verbosity "reconfiguring to enable tests"+            let flags' = ( configFlags { configTests = toFlag True }+                        , configExFlags+                        )+            pure (Any True, flags')++  _ <-+    reconfigure configureAction+    verbosity distPref (buildNumJobs buildFlags')+    checkFlags [] globalFlags config+  nixShell verbosity distPref globalFlags config $ do+    let setupOptions   = defaultSetupScriptOptions { useDistPref = distPref }+        testFlags'     = testFlags { testDistPref = toFlag distPref }++    -- The package was just configured, so the LBI must be available.+    names <- componentNamesFromLBI verbosity distPref "test suites"+              (\c -> case c of { LBI.CTest{} -> True; _ -> False })+    let extraArgs'+          | null extraArgs = case names of+            ComponentNamesUnknown -> []+            ComponentNames names' -> [ Make.unUnqualComponentName name+                                    | LBI.CTestName name <- names' ]+          | otherwise      = extraArgs++    build verbosity config distPref buildFlags' extraArgs'+    setupWrapper verbosity setupOptions Nothing Cabal.testCommand (const testFlags') (const extraArgs')++data ComponentNames = ComponentNamesUnknown+                    | ComponentNames [LBI.ComponentName]++-- | Return the names of all buildable components matching a given predicate.+componentNamesFromLBI :: Verbosity -> FilePath -> String+                         -> (LBI.Component -> Bool)+                         -> IO ComponentNames+componentNamesFromLBI verbosity distPref targetsDescr compPred = do+  eLBI <- tryGetPersistBuildConfig distPref+  case eLBI of+    Left err -> case err of+      -- Note: the build config could have been generated by a custom setup+      -- script built against a different Cabal version, so it's crucial that+      -- we ignore the bad version error here.+      ConfigStateFileBadVersion _ _ _ -> return ComponentNamesUnknown+      _                               -> die' verbosity (show err)+    Right lbi -> do+      let pkgDescr = LBI.localPkgDescr lbi+          names    = map LBI.componentName+                     . filter (buildable . LBI.componentBuildInfo)+                     . filter compPred $+                     LBI.pkgComponents pkgDescr+      if null names+        then do notice verbosity $ "Package has no buildable "+                  ++ targetsDescr ++ "."+                exitSuccess -- See #3215.++        else return $! (ComponentNames names)++benchmarkAction :: (BuildFlags, BenchmarkFlags)+                   -> [String] -> GlobalFlags+                   -> IO ()+benchmarkAction+  (buildFlags, benchmarkFlags)+  extraArgs globalFlags = do+  let verbosity      = fromFlagOrDefault normal+                       (buildVerbosity buildFlags)++  config <- loadConfigOrSandboxConfig verbosity globalFlags+  distPref <- findSavedDistPref config (benchmarkDistPref benchmarkFlags)+  let buildFlags'    = buildFlags+                      { buildVerbosity = benchmarkVerbosity benchmarkFlags }++  let checkFlags = Check $ \_ flags@(configFlags, configExFlags) ->+        if fromFlagOrDefault False (configBenchmarks configFlags)+          then pure (mempty, flags)+          else do+            info verbosity "reconfiguring to enable benchmarks"+            let flags' = ( configFlags { configBenchmarks = toFlag True }+                        , configExFlags+                        )+            pure (Any True, flags')++  config' <-+    reconfigure configureAction+    verbosity distPref (buildNumJobs buildFlags')+    checkFlags [] globalFlags config+  nixShell verbosity distPref globalFlags config $ do+    let setupOptions   = defaultSetupScriptOptions { useDistPref = distPref }+        benchmarkFlags'= benchmarkFlags { benchmarkDistPref = toFlag distPref }++    -- The package was just configured, so the LBI must be available.+    names <- componentNamesFromLBI verbosity distPref "benchmarks"+            (\c -> case c of { LBI.CBench{} -> True; _ -> False; })+    let extraArgs'+          | null extraArgs = case names of+            ComponentNamesUnknown -> []+            ComponentNames names' -> [ Make.unUnqualComponentName name+                                    | LBI.CBenchName name <- names']+          | otherwise      = extraArgs++    build verbosity config' distPref buildFlags' extraArgs'+    setupWrapper verbosity setupOptions Nothing Cabal.benchmarkCommand (const benchmarkFlags') (const extraArgs')++haddockAction :: HaddockFlags -> [String] -> Action+haddockAction haddockFlags extraArgs globalFlags = do+  let verbosity = fromFlag (haddockVerbosity haddockFlags)+  config <- loadConfigOrSandboxConfig verbosity globalFlags+  distPref <- findSavedDistPref config (haddockDistPref haddockFlags)+  config' <-+    reconfigure configureAction+    verbosity distPref NoFlag+    mempty [] globalFlags config+  nixShell verbosity distPref globalFlags config $ do+    let haddockFlags' = defaultHaddockFlags      `mappend`+                        savedHaddockFlags config' `mappend`+                        haddockFlags { haddockDistPref = toFlag distPref }+        setupScriptOptions = defaultSetupScriptOptions+                             { useDistPref = distPref }+    setupWrapper verbosity setupScriptOptions Nothing+      haddockCommand (const haddockFlags') (const extraArgs)+    when (haddockForHackage haddockFlags == Flag ForHackage) $ do+      pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig distPref)+      let dest = distPref </> name <.> "tar.gz"+          name = display (packageId pkg) ++ "-docs"+          docDir = distPref </> "doc" </> "html"+      createTarGzFile dest docDir name+      notice verbosity $ "Documentation tarball created: " ++ dest++cleanAction :: CleanFlags -> [String] -> Action+cleanAction cleanFlags extraArgs globalFlags = do+  load <- try (loadConfigOrSandboxConfig verbosity globalFlags)+  let config = either (\(SomeException _) -> mempty) id load+  distPref <- findSavedDistPref config (cleanDistPref cleanFlags)+  let setupScriptOptions = defaultSetupScriptOptions+                           { useDistPref = distPref+                           , useWin32CleanHack = True+                           }+      cleanFlags' = cleanFlags { cleanDistPref = toFlag distPref }+  setupWrapper verbosity setupScriptOptions Nothing+               cleanCommand (const cleanFlags') (const extraArgs)+  where+    verbosity = fromFlagOrDefault normal (cleanVerbosity cleanFlags)++listAction :: ListFlags -> [String] -> Action+listAction listFlags extraArgs globalFlags = do+  let verbosity = fromFlag (listVerbosity listFlags)+  config <- loadConfigOrSandboxConfig verbosity globalFlags+  let configFlags' = savedConfigureFlags config+      configFlags  = configFlags'+        { configPackageDBs = configPackageDBs configFlags'+                           `mappend` listPackageDBs listFlags+        , configHcPath     = listHcPath listFlags+        }+      globalFlags' = savedGlobalFlags    config `mappend` globalFlags+  compProgdb <- if listNeedsCompiler listFlags+      then do+          (comp, _, progdb) <- configCompilerAux' configFlags+          return (Just (comp, progdb))+      else return Nothing+  withRepoContext verbosity globalFlags' $ \repoContext ->+    List.list verbosity+       (configPackageDB' configFlags)+       repoContext+       compProgdb+       listFlags+       extraArgs++infoAction :: InfoFlags -> [String] -> Action+infoAction infoFlags extraArgs globalFlags = do+  let verbosity = fromFlag (infoVerbosity infoFlags)+  targets <- readUserTargets verbosity extraArgs+  config <- loadConfigOrSandboxConfig verbosity globalFlags+  let configFlags' = savedConfigureFlags config+      configFlags  = configFlags' {+        configPackageDBs = configPackageDBs configFlags'+                           `mappend` infoPackageDBs infoFlags+        }+      globalFlags' = savedGlobalFlags    config `mappend` globalFlags+  (comp, _, progdb) <- configCompilerAuxEx configFlags+  withRepoContext verbosity globalFlags' $ \repoContext ->+    List.info verbosity+       (configPackageDB' configFlags)+       repoContext+       comp+       progdb+       globalFlags'+       infoFlags+       targets++fetchAction :: FetchFlags -> [String] -> Action+fetchAction fetchFlags extraArgs globalFlags = do+  let verbosity = fromFlag (fetchVerbosity fetchFlags)+  targets <- readUserTargets verbosity extraArgs+  config <- loadConfig verbosity (globalConfigFile globalFlags)+  let configFlags  = savedConfigureFlags config+      globalFlags' = savedGlobalFlags config `mappend` globalFlags+  (comp, platform, progdb) <- configCompilerAux' configFlags+  withRepoContext verbosity globalFlags' $ \repoContext ->+    fetch verbosity+        (configPackageDB' configFlags)+        repoContext+        comp platform progdb globalFlags' fetchFlags+        targets++freezeAction :: FreezeFlags -> [String] -> Action+freezeAction freezeFlags _extraArgs globalFlags = do+  let verbosity = fromFlag (freezeVerbosity freezeFlags)+  config <- loadConfigOrSandboxConfig verbosity globalFlags+  distPref <- findSavedDistPref config NoFlag+  nixShell verbosity distPref globalFlags config $ do+    let configFlags  = savedConfigureFlags config+        globalFlags' = savedGlobalFlags config `mappend` globalFlags+    (comp, platform, progdb) <- configCompilerAux' configFlags++    withRepoContext verbosity globalFlags' $ \repoContext ->+        freeze verbosity+            (configPackageDB' configFlags)+            repoContext+            comp platform progdb+            globalFlags' freezeFlags++genBoundsAction :: FreezeFlags -> [String] -> GlobalFlags -> IO ()+genBoundsAction freezeFlags _extraArgs globalFlags = do+  let verbosity = fromFlag (freezeVerbosity freezeFlags)+  config <- loadConfigOrSandboxConfig verbosity globalFlags+  distPref <- findSavedDistPref config NoFlag+  nixShell verbosity distPref globalFlags config $ do+    let configFlags  = savedConfigureFlags config+        globalFlags' = savedGlobalFlags config `mappend` globalFlags+    (comp, platform, progdb) <- configCompilerAux' configFlags++    withRepoContext verbosity globalFlags' $ \repoContext ->+        genBounds verbosity+                (configPackageDB' configFlags)+                repoContext+                comp platform progdb+                globalFlags' freezeFlags++uploadAction :: UploadFlags -> [String] -> Action+uploadAction uploadFlags extraArgs globalFlags = do+  config <- loadConfig verbosity (globalConfigFile globalFlags)+  let uploadFlags' = savedUploadFlags config `mappend` uploadFlags+      globalFlags' = savedGlobalFlags config `mappend` globalFlags+      tarfiles     = extraArgs+  when (null tarfiles && not (fromFlag (uploadDoc uploadFlags'))) $+    die' verbosity "the 'upload' command expects at least one .tar.gz archive."+  checkTarFiles extraArgs+  maybe_password <-+    case uploadPasswordCmd uploadFlags'+    of Flag (xs:xss) -> Just . Password <$>+                        getProgramInvocationOutput verbosity+                        (simpleProgramInvocation xs xss)+       _             -> pure $ flagToMaybe $ uploadPassword uploadFlags'+  withRepoContext verbosity globalFlags' $ \repoContext -> do+    if fromFlag (uploadDoc uploadFlags')+    then do+      when (length tarfiles > 1) $+       die' verbosity $ "the 'upload' command can only upload documentation "+             ++ "for one package at a time."+      tarfile <- maybe (generateDocTarball config) return $ listToMaybe tarfiles+      Upload.uploadDoc verbosity+                       repoContext+                       (flagToMaybe $ uploadUsername uploadFlags')+                       maybe_password+                       (fromFlag (uploadCandidate uploadFlags'))+                       tarfile+    else do+      Upload.upload verbosity+                    repoContext+                    (flagToMaybe $ uploadUsername uploadFlags')+                    maybe_password+                    (fromFlag (uploadCandidate uploadFlags'))+                    tarfiles+    where+    verbosity = fromFlag (uploadVerbosity uploadFlags)+    checkTarFiles tarfiles+      | not (null otherFiles)+      = die' verbosity $ "the 'upload' command expects only .tar.gz archives: "+           ++ intercalate ", " otherFiles+      | otherwise = sequence_+                      [ do exists <- doesFileExist tarfile+                           unless exists $ die' verbosity $ "file not found: " ++ tarfile+                      | tarfile <- tarfiles ]++      where otherFiles = filter (not . isTarGzFile) tarfiles+            isTarGzFile file = case splitExtension file of+              (file', ".gz") -> takeExtension file' == ".tar"+              _              -> False+    generateDocTarball config = do+      notice verbosity $+        "No documentation tarball specified. "+        ++ "Building a documentation tarball with default settings...\n"+        ++ "If you need to customise Haddock options, "+        ++ "run 'haddock --for-hackage' first "+        ++ "to generate a documentation tarball."+      haddockAction (defaultHaddockFlags { haddockForHackage = Flag ForHackage })+                    [] globalFlags+      distPref <- findSavedDistPref config NoFlag+      pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig distPref)+      return $ distPref </> display (packageId pkg) ++ "-docs" <.> "tar.gz"++checkAction :: Flag Verbosity -> [String] -> Action+checkAction verbosityFlag extraArgs _globalFlags = do+  let verbosity = fromFlag verbosityFlag+  unless (null extraArgs) $+    die' verbosity $ "'check' doesn't take any extra arguments: " ++ unwords extraArgs+  allOk <- Check.check (fromFlag verbosityFlag)+  unless allOk exitFailure++formatAction :: Flag Verbosity -> [String] -> Action+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+  -- Uses 'writeFileAtomic' under the hood.+  writeGenericPackageDescription path pkgDesc++reportAction :: ReportFlags -> [String] -> Action+reportAction reportFlags extraArgs globalFlags = do+  let verbosity = fromFlag (reportVerbosity reportFlags)+  unless (null extraArgs) $+    die' verbosity $ "'report' doesn't take any extra arguments: " ++ unwords extraArgs+  config <- loadConfig verbosity (globalConfigFile globalFlags)+  let globalFlags' = savedGlobalFlags config `mappend` globalFlags+      reportFlags' = savedReportFlags config `mappend` reportFlags++  withRepoContext verbosity globalFlags' $ \repoContext ->+   Upload.report verbosity repoContext+    (flagToMaybe $ reportUsername reportFlags')+    (flagToMaybe $ reportPassword reportFlags')++runAction :: BuildFlags -> [String] -> Action+runAction buildFlags extraArgs globalFlags = do+  let verbosity   = fromFlagOrDefault normal (buildVerbosity buildFlags)+  config <- loadConfigOrSandboxConfig verbosity globalFlags+  distPref <- findSavedDistPref config (buildDistPref buildFlags)+  config' <-+    reconfigure configureAction+    verbosity distPref (buildNumJobs buildFlags)+    mempty [] globalFlags config+  nixShell verbosity distPref globalFlags config $ do+    lbi <- getPersistBuildConfig distPref+    (exe, exeArgs) <- splitRunArgs verbosity lbi extraArgs++    build verbosity config' distPref buildFlags ["exe:" ++ display (exeName exe)]+    run verbosity lbi exe exeArgs++getAction :: GetFlags -> [String] -> Action+getAction getFlags extraArgs globalFlags = do+  let verbosity = fromFlag (getVerbosity getFlags)+  targets <- readUserTargets verbosity extraArgs+  config <- loadConfigOrSandboxConfig verbosity globalFlags+  let globalFlags' = savedGlobalFlags config `mappend` globalFlags+  withRepoContext verbosity (savedGlobalFlags config) $ \repoContext ->+   get verbosity+    repoContext+    globalFlags'+    getFlags+    targets++unpackAction :: GetFlags -> [String] -> Action+unpackAction getFlags extraArgs globalFlags = do+  getAction getFlags extraArgs globalFlags++initAction :: InitFlags -> [String] -> Action+initAction initFlags extraArgs globalFlags = do+  -- it takes the first value within extraArgs (if there's one)+  -- and uses it as the root directory for the new project+  case extraArgs of+    [] -> initAction'+    [projectDir] -> do+      createDirectoryIfMissingVerbose verbosity True projectDir+      withCurrentDirectory projectDir initAction'+    _ -> die' verbosity $+      "'init' only takes a single, optional, extra " +++      "argument for the project root directory"+  where+    initAction' = do+      confFlags <- loadConfigOrSandboxConfig verbosity globalFlags+      -- override with `--with-compiler` from CLI if available+      let confFlags' = savedConfigureFlags confFlags `mappend` compFlags+          initFlags' = savedInitFlags confFlags `mappend` initFlags+          globalFlags' = savedGlobalFlags confFlags `mappend` globalFlags++      (comp, _, progdb) <- configCompilerAux' confFlags'++      withRepoContext verbosity globalFlags' $ \repoContext ->+        initCmd verbosity (configPackageDB' confFlags')+          repoContext comp progdb initFlags'++    verbosity = fromFlag (initVerbosity initFlags)+    compFlags = mempty { configHcPath = initHcPath initFlags }++userConfigAction :: UserConfigFlags -> [String] -> Action+userConfigAction ucflags extraArgs globalFlags = do+  let verbosity  = fromFlag (userConfigVerbosity ucflags)+      frc        = fromFlag (userConfigForce ucflags)+      extraLines = fromFlag (userConfigAppendLines ucflags)+  case extraArgs of+    ("init":_) -> do+      path       <- configFile+      fileExists <- doesFileExist path+      if (not fileExists || (fileExists && frc))+      then void $ createDefaultConfigFile verbosity extraLines path+      else die' verbosity $ path ++ " already exists."+    ("diff":_) -> traverse_ putStrLn =<< userConfigDiff verbosity globalFlags extraLines+    ("update":_) -> userConfigUpdate verbosity globalFlags extraLines+    -- Error handling.+    [] -> die' verbosity $ "Please specify a subcommand (see 'help user-config')"+    _  -> die' verbosity $ "Unknown 'user-config' subcommand: " ++ unwords extraArgs+  where configFile = getConfigFilePath (globalConfigFile globalFlags)++-- | Used as an entry point when cabal-install needs to invoke itself+-- as a setup script. This can happen e.g. when doing parallel builds.+--+actAsSetupAction :: ActAsSetupFlags -> [String] -> Action+actAsSetupAction actAsSetupFlags args _globalFlags =+  let bt = fromFlag (actAsSetupBuildType actAsSetupFlags)+  in case bt of+    Simple    -> Simple.defaultMainArgs args+    Configure -> Simple.defaultMainWithHooksArgs+                  Simple.autoconfUserHooks args+    Make      -> Make.defaultMainArgs args+    Custom    -> error "actAsSetupAction Custom"++manpageAction :: [CommandSpec action] -> ManpageFlags -> [String] -> Action+manpageAction commands flags extraArgs _ = do+  let verbosity = fromFlag (manpageVerbosity flags)+  unless (null extraArgs) $+    die' verbosity $ "'man' doesn't take any extra arguments: " ++ unwords extraArgs+  pname <- getProgName+  let cabalCmd = if takeExtension pname == ".exe"+                 then dropExtension pname+                 else pname+  manpageCmd cabalCmd commands flags

@@ -31,6 +31,7 @@     readProjectLocalFreezeConfig,     reportParseResult,     showProjectConfig,+    withGlobalConfig,     withProjectOrGlobalConfig,     writeProjectLocalExtraConfig,     writeProjectLocalFreezeConfig,@@ -461,6 +462,15 @@ renderBadProjectRoot :: BadProjectRoot -> String renderBadProjectRoot (BadProjectRootExplicitFile projectFile) =     "The given project file '" ++ projectFile ++ "' does not exist."++withGlobalConfig+    :: Verbosity                  -- ^ verbosity+    -> Flag FilePath              -- ^ @--cabal-config@+    -> (ProjectConfig -> IO a)    -- ^ with global+    -> IO a+withGlobalConfig verbosity gcf with = do+    globalConfig <- runRebuild "" $ readGlobalConfig verbosity gcf+    with globalConfig  withProjectOrGlobalConfig     :: Verbosity                  -- ^ verbosity

@@ -321,9 +321,17 @@                      }                      cliConfig = do +    progsearchpath <- liftIO $ getSystemSearchPath++    let fileMonitorProjectConfig = newFileMonitor (distProjectCacheFile "config")+     fileMonitorProjectConfigKey <- do       configPath <- getConfigFilePath projectConfigConfigFile-      return (configPath, distProjectFile "")+      return (configPath, distProjectFile "",+                        (projectConfigHcFlavor, projectConfigHcPath, projectConfigHcPkg),+                        progsearchpath,+                        packageConfigProgramPaths,+                        packageConfigProgramPathExtra)      (projectConfig, localPackages) <-       runRebuild distProjectRootDirectory@@ -354,18 +362,11 @@    where -    ProjectConfigShared { projectConfigConfigFile } =-      projectConfigShared cliConfig--    ProjectConfigShared { projectConfigIgnoreProject } =+    ProjectConfigShared { projectConfigHcFlavor, projectConfigHcPath, projectConfigHcPkg, projectConfigIgnoreProject, projectConfigConfigFile } =       projectConfigShared cliConfig -    fileMonitorProjectConfig ::-      FileMonitor-        (FilePath, FilePath)-        (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])-    fileMonitorProjectConfig =-      newFileMonitor (distProjectCacheFile "config")+    PackageConfig { packageConfigProgramPaths, packageConfigProgramPathExtra } =+      projectConfigLocalPackages cliConfig      -- Read the cabal.project (or implicit config) and combine it with     -- arguments from the command line

@@ -9,7 +9,8 @@     getScriptHash, getScriptCacheDirectory, ensureScriptCacheDirectory,     withContextAndSelectors, AcceptNoTargets(..), TargetContext(..),     updateContextAndWriteProjectFile, updateContextAndWriteProjectFile',-    fakeProjectSourcePackage, lSrcpkgDescription+    fakeProjectSourcePackage, lSrcpkgDescription,+    movedExePath   ) where  import Prelude ()@@ -24,22 +25,24 @@ import Distribution.Client.Config     ( defaultScriptBuildsDir ) import Distribution.Client.DistDirLayout-    ( DistDirLayout(..) )+    ( DistDirLayout(..), DistDirParams(..) ) import Distribution.Client.HashValue-    ( hashValue, showHashValue )+    ( hashValue, showHashValueBase64 ) import Distribution.Client.HttpUtils          ( HttpTransport, configureTransport ) import Distribution.Client.NixStyleOptions     ( NixStyleFlags (..) ) import Distribution.Client.ProjectConfig-    ( ProjectConfig(..), ProjectConfigShared(..)-    , reportParseResult, withProjectOrGlobalConfig+    ( ProjectConfig(..), ProjectConfigShared(..), PackageConfig(..)+    , reportParseResult, withGlobalConfig, withProjectOrGlobalConfig     , projectConfigHttpTransport ) import Distribution.Client.ProjectConfig.Legacy     ( ProjectConfigSkeleton     , parseProjectSkeleton, instantiateProjectConfigSkeletonFetchingCompiler ) import Distribution.Client.ProjectFlags     ( flagIgnoreProject )+import Distribution.Client.ProjectPlanning+    ( ElaboratedSharedConfig(..), ElaboratedConfiguredPackage(..) ) import Distribution.Client.RebuildMonad     ( runRebuild ) import Distribution.Client.Setup@@ -48,6 +51,8 @@     ( TargetSelectorProblem(..), TargetString(..) ) import Distribution.Client.Types     ( PackageLocation(..), PackageSpecifier(..), UnresolvedSourcePackage )+import Distribution.Compiler+    ( CompilerId(..), perCompilerFlavorToList ) import Distribution.FieldGrammar     ( parseFieldGrammar, takeFields ) import Distribution.Fields@@ -67,7 +72,7 @@ import Distribution.Simple.Setup     ( Flag(..) ) import Distribution.Simple.Compiler-    ( compilerInfo )+    ( Compiler(..), OptimisationLevel(..), compilerInfo ) import Distribution.Simple.Utils     ( createDirectoryIfMissingVerbose, createTempDirectory, die', handleDoesNotExist, readUTF8File, warn, writeUTF8File ) import qualified Distribution.SPDX.License as SPDX@@ -77,6 +82,8 @@     ( Platform(..) ) import Distribution.Types.BuildInfo     ( BuildInfo(..) )+import Distribution.Types.ComponentId+    ( mkComponentId ) import Distribution.Types.CondTree     ( CondTree(..) ) import Distribution.Types.Executable@@ -87,6 +94,10 @@     ( PackageDescription(..), emptyPackageDescription ) import Distribution.Types.PackageName.Magic     ( fakePackageCabalFileName, fakePackageId )+import Distribution.Types.UnitId+    ( newSimpleUnitId )+import Distribution.Types.UnqualComponentName+    ( UnqualComponentName ) import Distribution.Utils.NubList     ( fromNubList ) import Distribution.Client.ProjectPlanning@@ -106,7 +117,7 @@ import System.Directory     ( canonicalizePath, doesFileExist, getTemporaryDirectory, removeDirectoryRecursive ) import System.FilePath-    ( (</>), takeFileName )+    ( (</>), makeRelative, takeDirectory, takeFileName ) import qualified Text.Parsec as P  -- A note on multi-module script support #6787:@@ -125,7 +136,12 @@ -- Two hashes will be the same as long as the absolute paths -- are the same. getScriptHash :: FilePath -> IO String-getScriptHash script = showHashValue . hashValue . fromString <$> canonicalizePath script+getScriptHash script+  -- Base64 is shorter than Base16, which helps avoid long path issues on windows+  -- but it can contain /'s which aren't valid in file paths so replace them with+  -- %'s. 26 chars / 130 bits is enough to practically avoid collisions.+  = map (\c -> if c == '/' then '%' else c) . take 26+  . showHashValueBase64 . hashValue . fromString <$> canonicalizePath script  -- | Get the directory for caching a script build. --@@ -177,7 +193,7 @@   -> IO b withContextAndSelectors noTargets kind flags@NixStyleFlags {..} targetStrings globalFlags cmd act   = withTemporaryTempDirectory $ \mkTmpDir -> do-    (tc, ctx) <- withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag with (without mkTmpDir)+    (tc, ctx) <- withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag withProject (withoutProject mkTmpDir)      (tc', ctx', sels) <- case targetStrings of       -- Only script targets may contain spaces and or end with ':'.@@ -209,19 +225,25 @@     globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig)     defaultTarget = [TargetPackage TargetExplicitNamed [fakePackageId] Nothing] -    with = do+    withProject = do       ctx <- establishProjectBaseContext verbosity cliConfig cmd       return (ProjectContext, ctx)-    without mkDir globalConfig = do-      distDirLayout <- establishDummyDistDirLayout verbosity (globalConfig <> cliConfig) =<< mkDir+    withoutProject mkTmpDir globalConfig = do+      distDirLayout <- establishDummyDistDirLayout verbosity (globalConfig <> cliConfig) =<< mkTmpDir       ctx <- establishDummyProjectBaseContext verbosity (globalConfig <> cliConfig) distDirLayout [] cmd       return (GlobalContext, ctx)++    scriptBaseCtx script globalConfig = do+      let noDistDir = mempty { projectConfigShared = mempty { projectConfigDistDir = Flag "" } }+      let cfg = noDistDir <> globalConfig <> cliConfig+      rootDir <- ensureScriptCacheDirectory verbosity script+      distDirLayout <- establishDummyDistDirLayout verbosity cfg rootDir+      establishDummyProjectBaseContext verbosity cfg distDirLayout [] cmd+     scriptOrError script err = do       exists <- doesFileExist script       if exists then do-        -- In the script case we always want a dummy context even when ignoreProject is False-        let mkCacheDir = ensureScriptCacheDirectory verbosity script-        (_, ctx) <- withProjectOrGlobalConfig verbosity (Flag True) globalConfigFlag with (without mkCacheDir)+        ctx <- withGlobalConfig verbosity globalConfigFlag (scriptBaseCtx script)          let projectRoot = distProjectRootDirectory $ distDirLayout ctx         writeFile (projectRoot </> "scriptlocation") =<< canonicalizePath script@@ -236,14 +258,22 @@          projectCfgSkeleton <- readProjectBlockFromScript verbosity httpTransport (distDirLayout ctx) (takeFileName script) scriptContents -        let fetchCompiler = do-               (compiler, Platform arch os, _) <- runRebuild (distProjectRootDirectory . distDirLayout $ ctx) $ configureCompiler verbosity (distDirLayout ctx) ((fst $ ignoreConditions projectCfgSkeleton) <> projectConfig ctx)-               pure (os, arch, compilerInfo compiler)+        createDirectoryIfMissingVerbose verbosity True (distProjectCacheDirectory $ distDirLayout ctx)+        (compiler, platform@(Platform arch os), _) <- runRebuild projectRoot $ configureCompiler verbosity (distDirLayout ctx) (fst (ignoreConditions projectCfgSkeleton) <> projectConfig ctx) -        projectCfg <- instantiateProjectConfigSkeletonFetchingCompiler fetchCompiler mempty projectCfgSkeleton+        projectCfg <- instantiateProjectConfigSkeletonFetchingCompiler (pure (os, arch, compilerInfo compiler)) mempty projectCfgSkeleton -        let executable' = executable & L.buildInfo . L.defaultLanguage %~ maybe (Just Haskell2010) Just-            ctx'        = ctx & lProjectConfig %~ (<> projectCfg)+        let ctx' = ctx & lProjectConfig %~ (<> projectCfg)++            build_dir = distBuildDirectory (distDirLayout ctx') $ (scriptDistDirParams script) ctx' compiler platform+            exePath = build_dir </> "bin" </> scriptExeFileName script+            exePathRel = makeRelative projectRoot exePath++            executable' = executable & L.buildInfo . L.defaultLanguage %~ maybe (Just Haskell2010) Just+                                     & L.buildInfo . L.options %~ fmap (setExePath exePathRel)++        createDirectoryIfMissingVerbose verbosity True (takeDirectory exePath)+         return (ScriptContext script executable', ctx', defaultTarget)       else reportTargetSelectorProblems verbosity err @@ -260,6 +290,36 @@       return tmpDir     rmTmp m _ = tryTakeMVar m >>= maybe (return ()) (handleDoesNotExist () . removeDirectoryRecursive) +scriptComponenetName :: IsString s => FilePath -> s+scriptComponenetName scriptPath = fromString cname+  where+    cname = "script-" ++ map censor (takeFileName scriptPath)+    censor c | c `S.member` ccNamecore = c+             | otherwise               = '_'++scriptExeFileName :: FilePath -> FilePath+scriptExeFileName scriptPath = "cabal-script-" ++ takeFileName scriptPath++scriptDistDirParams :: FilePath -> ProjectBaseContext -> Compiler -> Platform -> DistDirParams+scriptDistDirParams scriptPath ctx compiler platform = DistDirParams+  { distParamUnitId         = newSimpleUnitId cid+  , distParamPackageId      = fakePackageId+  , distParamComponentId    = cid+  , distParamComponentName  = Just $ CExeName cn+  , distParamCompilerId     = compilerId compiler+  , distParamPlatform       = platform+  , distParamOptimization   = fromFlagOrDefault NormalOptimisation optimization+  }+  where+      cn = scriptComponenetName scriptPath+      cid = mkComponentId $ prettyShow fakePackageId <> "-inplace-" <> prettyShow cn+      optimization = (packageConfigOptimization . projectConfigLocalPackages . projectConfig) ctx++setExePath :: FilePath -> [String] -> [String]+setExePath exePath options+  | "-o" `notElem` options = "-o" : exePath : options+  | otherwise              = options+ -- | Add the 'SourcePackage' to the context and use it to write a .cabal file. updateContextAndWriteProjectFile' :: ProjectBaseContext -> SourcePackage (PackageLocation (Maybe FilePath)) -> IO ProjectBaseContext updateContextAndWriteProjectFile' ctx srcPkg = do@@ -284,15 +344,9 @@    absScript <- canonicalizePath scriptPath   let-    -- Replace characters which aren't allowed in the executable component name with '_'-    -- Prefix with "cabal-script-" to make it clear to end users that the name may be mangled-    scriptExeName = "cabal-script-" ++ map censor (takeFileName scriptPath)-    censor c | c `S.member` ccNamecore = c-             | otherwise               = '_'-     sourcePackage = fakeProjectSourcePackage projectRoot       & lSrcpkgDescription . L.condExecutables-      .~ [(fromString scriptExeName, CondNode executable (targetBuildDepends $ buildInfo executable) [])]+      .~ [(scriptComponenetName scriptPath, CondNode executable (targetBuildDepends $ buildInfo executable) [])]     executable = scriptExecutable       & L.modulePath .~ absScript @@ -394,6 +448,15 @@       , specVersion = CabalSpecV2_2       , licenseRaw = Left SPDX.NONE       }++-- | Find the path of an exe that has been relocated with a "-o" option+movedExePath :: UnqualComponentName -> DistDirLayout -> ElaboratedSharedConfig -> ElaboratedConfiguredPackage -> Maybe FilePath+movedExePath selectedComponent distDirLayout elabShared elabConfigured = do+  exe <- find ((== selectedComponent) . exeName) . executables $ elabPkgDescription elabConfigured+  let CompilerId flavor _ = (compilerId . pkgConfigCompiler) elabShared+  opts <- lookup flavor (perCompilerFlavorToList . options $ buildInfo exe)+  let projectRoot = distProjectRootDirectory distDirLayout+  fmap (projectRoot </>) . lookup "-o" $ reverse (zip opts (drop 1 opts))  -- Lenses -- | A lens for the 'srcpkgDescription' field of 'SourcePackage'

@@ -72,7 +72,11 @@ import qualified Distribution.Client.Init.Types as IT import qualified Distribution.Client.Init.Defaults as IT import Distribution.Client.Targets-         ( UserConstraint, readUserConstraint )+  ( UserConstraint+  , readUserConstraint+  )+import Distribution.Deprecated.ParseUtils (parseSpaceList, parseTokenQ)+import Distribution.Deprecated.ReadP (readP_to_E) import Distribution.Utils.NubList          ( NubList, toNubList, fromNubList) @@ -369,7 +373,7 @@           optArg' "(True or False)" (maybeToFlag . (readMaybe =<<)) (\case             Flag True -> [Just "enable"]             Flag False -> [Just "disable"]-            NoFlag -> [Just "disable"]) "" ["nix"]+            NoFlag -> []) "" ["nix"] -- Must be empty because we need to return PP.empty from viewAsFieldDescr             "Nix integration: run commands through nix-shell if a 'shell.nix' file exists (default is False)",           noArg (Flag True) [] ["enable-nix"]           "Enable Nix integration: run commands through nix-shell if a 'shell.nix' file exists",@@ -2004,51 +2008,77 @@   }  uploadCommand :: CommandUI UploadFlags-uploadCommand = CommandUI {-    commandName         = "upload",-    commandSynopsis     = "Uploads source packages or documentation to Hackage.",-    commandDescription  = Nothing,-    commandNotes        = Just $ \_ ->-         "You can store your Hackage login in the ~/.config/cabal/config file\n"-      ++ relevantConfigValuesText ["username", "password", "password-command"],-    commandUsage        = \pname ->-         "Usage: " ++ pname ++ " upload [FLAGS] TARFILES\n",-    commandDefaultFlags = defaultUploadFlags,-    commandOptions      = \_ ->-      [optionVerbosity uploadVerbosity-       (\v flags -> flags { uploadVerbosity = v })--      ,option [] ["publish"]-        "Publish the package instead of uploading it as a candidate."-        uploadCandidate (\v flags -> flags { uploadCandidate = v })-        (noArg (Flag IsPublished))--      ,option ['d'] ["documentation"]-        ("Upload documentation instead of a source package. "-        ++ "By default, this uploads documentation for a package candidate. "-        ++ "To upload documentation for "-        ++ "a published package, combine with --publish.")-        uploadDoc (\v flags -> flags { uploadDoc = v })-        trueArg--      ,option ['u'] ["username"]-        "Hackage username."-        uploadUsername (\v flags -> flags { uploadUsername = v })-        (reqArg' "USERNAME" (toFlag . Username)-                            (flagToList . fmap unUsername))--      ,option ['p'] ["password"]-        "Hackage password."-        uploadPassword (\v flags -> flags { uploadPassword = v })-        (reqArg' "PASSWORD" (toFlag . Password)-                            (flagToList . fmap unPassword))--      ,option ['P'] ["password-command"]-        "Command to get Hackage password."-        uploadPasswordCmd (\v flags -> flags { uploadPasswordCmd = v })-        (reqArg' "PASSWORD" (Flag . words) (fromMaybe [] . flagToMaybe))-      ]-  }+uploadCommand =+  CommandUI+    { commandName = "upload"+    , commandSynopsis = "Uploads source packages or documentation to Hackage."+    , commandDescription = Nothing+    , commandNotes = Just $ \_ ->+        "You can store your Hackage login in the ~/.config/cabal/config file\n"+          ++ relevantConfigValuesText ["username", "password", "password-command"]+    , commandUsage = \pname ->+        "Usage: " ++ pname ++ " upload [FLAGS] TARFILES\n"+    , commandDefaultFlags = defaultUploadFlags+    , commandOptions = \_ ->+        [ optionVerbosity+            uploadVerbosity+            (\v flags -> flags{uploadVerbosity = v})+        , option+            []+            ["publish"]+            "Publish the package instead of uploading it as a candidate."+            uploadCandidate+            (\v flags -> flags{uploadCandidate = v})+            (noArg (Flag IsPublished))+        , option+            ['d']+            ["documentation"]+            ( "Upload documentation instead of a source package. "+                ++ "By default, this uploads documentation for a package candidate. "+                ++ "To upload documentation for "+                ++ "a published package, combine with --publish."+            )+            uploadDoc+            (\v flags -> flags{uploadDoc = v})+            trueArg+        , option+            ['u']+            ["username"]+            "Hackage username."+            uploadUsername+            (\v flags -> flags{uploadUsername = v})+            ( reqArg'+                "USERNAME"+                (toFlag . Username)+                (flagToList . fmap unUsername)+            )+        , option+            ['p']+            ["password"]+            "Hackage password."+            uploadPassword+            (\v flags -> flags{uploadPassword = v})+            ( reqArg'+                "PASSWORD"+                (toFlag . Password)+                (flagToList . fmap unPassword)+            )+        , option+            ['P']+            ["password-command"]+            "Command to get Hackage password."+            uploadPasswordCmd+            (\v flags -> flags{uploadPasswordCmd = v})+            ( reqArg+                "COMMAND"+                ( readP_to_E+                    ("Cannot parse command: " ++)+                    (Flag <$> parseSpaceList parseTokenQ)+                )+                (flagElim [] (pure . unwords . fmap show))+            )+        ]+    }  instance Monoid UploadFlags where   mempty = gmempty

@@ -21,25 +21,43 @@  {-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE Rank2Types #-}-module Distribution.Deprecated.ParseUtils (-        LineNo, PError(..), PWarning(..), locatedErrorMsg, syntaxError, warning,-        runP, runE, ParseResult(..), parseFail, showPWarning,-        Field(..), lineNo,-        FieldDescr(..), readFields,-        parseHaskellString, parseTokenQ,-        parseOptCommaList,-        showFilePath, showToken, showFreeText,-        field, simpleField, listField, listFieldWithSep, spaceListField,-        newLineListField,-        liftField,-        readPToMaybe,--        fieldParsec, simpleFieldParsec,-        listFieldParsec,-        commaListFieldParsec,-        commaNewLineListFieldParsec,--        UnrecFieldParser,+module Distribution.Deprecated.ParseUtils+  ( LineNo+  , PError (..)+  , PWarning (..)+  , locatedErrorMsg+  , syntaxError+  , warning+  , runP+  , runE+  , ParseResult (..)+  , parseFail+  , showPWarning+  , Field (..)+  , lineNo+  , FieldDescr (..)+  , readFields+  , parseHaskellString+  , parseTokenQ+  , parseSpaceList+  , parseOptCommaList+  , showFilePath+  , showToken+  , showFreeText+  , field+  , simpleField+  , listField+  , listFieldWithSep+  , spaceListField+  , newLineListField+  , liftField+  , readPToMaybe+  , fieldParsec+  , simpleFieldParsec+  , listFieldParsec+  , commaListFieldParsec+  , commaNewLineListFieldParsec+  , UnrecFieldParser   ) where  import Distribution.Client.Compat.Prelude hiding (get)

@@ -50,7 +50,7 @@ import Distribution.InstalledPackageInfo (InstalledPackageInfo) import Distribution.Simple.Setup (toFlag, HaddockFlags(..), defaultHaddockFlags) import Distribution.Client.Setup (globalCommand)-import Distribution.Client.Config (loadConfig, SavedConfig(savedGlobalFlags))+import Distribution.Client.Config (loadConfig, SavedConfig(savedGlobalFlags), createDefaultConfigFile) import Distribution.Simple.Compiler import Distribution.Simple.Command import qualified Distribution.Simple.Flag as Flag@@ -62,6 +62,8 @@  import qualified Data.Map as Map import qualified Data.Set as Set+import Data.List (isInfixOf)+ import Control.Monad import Control.Concurrent (threadDelay) import Control.Exception hiding (assert)@@ -73,6 +75,7 @@ import Test.Tasty.HUnit import Test.Tasty.Options import Data.Tagged (Tagged(..))+import qualified Data.List as L  import qualified Data.ByteString as BS import Distribution.Client.GlobalFlags (GlobalFlags, globalNix)@@ -149,6 +152,7 @@   , testGroup "Flag tests" $     [       testCase "Test Nix Flag" testNixFlags,+      testCase "Test Config options for commented options" testConfigOptionComments,       testCase "Test Ignore Project Flag" testIgnoreProjectFlag     ]   ]@@ -1958,13 +1962,12 @@   Nothing @=? (fromFlag . globalNix . fromJust $ nixDefaultFlags)    -- Config file options-  defaultConfig <- loadConfig verbosity (Flag (basedir </> "nix-config/default-config"))   trueConfig <- loadConfig verbosity (Flag (basedir </> "nix-config/nix-true"))   falseConfig <- loadConfig verbosity (Flag (basedir </> "nix-config/nix-false")) -  Nothing @=? (fromFlag . globalNix . savedGlobalFlags $ defaultConfig)   Just True @=? (fromFlag . globalNix . savedGlobalFlags $ trueConfig)   Just False @=? (fromFlag . globalNix . savedGlobalFlags $ falseConfig)+   where     fromFlag :: Flag Bool -> Maybe Bool     fromFlag (Flag x) = Just x@@ -1972,6 +1975,225 @@     getFlags :: CommandUI GlobalFlags -> CommandParse (GlobalFlags -> GlobalFlags, [String]) -> Maybe GlobalFlags     getFlags cui (CommandReadyToGo (mkflags, _)) = Just . mkflags . commandDefaultFlags $ cui     getFlags _ _ = Nothing++-- Tests whether config options are commented or not+testConfigOptionComments :: Assertion+testConfigOptionComments = do+  _ <- createDefaultConfigFile verbosity [] (basedir </> "config/default-config")+  defaultConfigFile <- readFile (basedir </> "config/default-config")++  "  url" @=? findLineWith False "url" defaultConfigFile+  "  -- secure" @=? findLineWith True "secure" defaultConfigFile+  "  -- root-keys" @=? findLineWith True "root-keys" defaultConfigFile+  "  -- key-threshold" @=? findLineWith True "key-threshold" defaultConfigFile++  "-- ignore-expiry" @=? findLineWith True "ignore-expiry" defaultConfigFile+  "-- http-transport" @=? findLineWith True "http-transport" defaultConfigFile+  "-- nix" @=? findLineWith True "nix" defaultConfigFile+  "-- store-dir" @=? findLineWith True "store-dir" defaultConfigFile+  "-- active-repositories" @=? findLineWith True "active-repositories" defaultConfigFile+  "-- local-no-index-repo" @=? findLineWith True "local-no-index-repo" defaultConfigFile+  "remote-repo-cache"  @=? findLineWith False "remote-repo-cache" defaultConfigFile+  "-- logs-dir"  @=? findLineWith True "logs-dir" defaultConfigFile+  "-- default-user-config" @=? findLineWith True "default-user-config" defaultConfigFile+  "-- verbose" @=? findLineWith True "verbose" defaultConfigFile+  "-- compiler" @=? findLineWith True "compiler" defaultConfigFile+  "-- cabal-file" @=? findLineWith True "cabal-file" defaultConfigFile+  "-- with-compiler" @=? findLineWith True "with-compiler" defaultConfigFile+  "-- with-hc-pkg" @=? findLineWith True "with-hc-pkg" defaultConfigFile+  "-- program-prefix" @=? findLineWith True "program-prefix" defaultConfigFile+  "-- program-suffix" @=? findLineWith True "program-suffix" defaultConfigFile+  "-- library-vanilla" @=? findLineWith True "library-vanilla" defaultConfigFile+  "-- library-profiling" @=? findLineWith True "library-profiling" defaultConfigFile+  "-- shared" @=? findLineWith True "shared" defaultConfigFile+  "-- static" @=? findLineWith True "static" defaultConfigFile+  "-- executable-dynamic" @=? findLineWith True "executable-dynamic" defaultConfigFile+  "-- executable-static" @=? findLineWith True "executable-static" defaultConfigFile+  "-- profiling" @=? findLineWith True "profiling" defaultConfigFile+  "-- executable-profiling" @=? findLineWith True "executable-profiling" defaultConfigFile+  "-- profiling-detail" @=? findLineWith True "profiling-detail" defaultConfigFile+  "-- library-profiling-detail" @=? findLineWith True "library-profiling-detail" defaultConfigFile+  "-- optimization" @=? findLineWith True "optimization" defaultConfigFile+  "-- debug-info" @=? findLineWith True "debug-info" defaultConfigFile+  "-- build-info" @=? findLineWith True "build-info" defaultConfigFile+  "-- library-for-ghci" @=? findLineWith True "library-for-ghci" defaultConfigFile+  "-- split-sections" @=? findLineWith True "split-sections" defaultConfigFile+  "-- split-objs" @=? findLineWith True "split-objs" defaultConfigFile+  "-- executable-stripping" @=? findLineWith True "executable-stripping" defaultConfigFile+  "-- library-stripping" @=? findLineWith True "library-stripping" defaultConfigFile+  "-- configure-option" @=? findLineWith True "configure-option" defaultConfigFile+  "-- user-install"  @=? findLineWith True "user-install" defaultConfigFile+  "-- package-db"  @=? findLineWith True "package-db" defaultConfigFile+  "-- flags" @=? findLineWith True "flags" defaultConfigFile+  "-- extra-include-dirs" @=? findLineWith True "extra-include-dirs" defaultConfigFile+  "-- deterministic" @=? findLineWith True "deterministic" defaultConfigFile+  "-- cid" @=? findLineWith True "cid" defaultConfigFile+  "-- extra-lib-dirs" @=? findLineWith True "extra-lib-dirs" defaultConfigFile+  "-- extra-lib-dirs-static" @=? findLineWith True "extra-lib-dirs-static" defaultConfigFile+  "-- extra-framework-dirs" @=? findLineWith True "extra-framework-dirs" defaultConfigFile+  "-- extra-prog-path"  @=? findLineWith False "extra-prog-path" defaultConfigFile+  "-- instantiate-with" @=? findLineWith True "instantiate-with" defaultConfigFile+  "-- tests" @=? findLineWith True "tests" defaultConfigFile+  "-- coverage" @=? findLineWith True "coverage" defaultConfigFile+  "-- library-coverage" @=? findLineWith True "library-coverage" defaultConfigFile+  "-- exact-configuration" @=? findLineWith True "exact-configuration" defaultConfigFile+  "-- benchmarks" @=? findLineWith True "benchmarks" defaultConfigFile+  "-- relocatable"  @=? findLineWith True "relocatable" defaultConfigFile+  "-- response-files" @=? findLineWith True "response-files" defaultConfigFile+  "-- allow-depending-on-private-libs" @=? findLineWith True "allow-depending-on-private-libs" defaultConfigFile+  "-- cabal-lib-version" @=? findLineWith True "cabal-lib-version" defaultConfigFile+  "-- append" @=? findLineWith True "append" defaultConfigFile+  "-- backup" @=? findLineWith True "backup" defaultConfigFile+  "-- constraint" @=? findLineWith True "constraint" defaultConfigFile+  "-- preference" @=? findLineWith True "preference" defaultConfigFile+  "-- solver"  @=? findLineWith True "solver" defaultConfigFile+  "-- allow-older"  @=? findLineWith True "allow-older" defaultConfigFile+  "-- allow-newer"  @=? findLineWith True "allow-newer" defaultConfigFile+  "-- write-ghc-environment-files" @=? findLineWith True "write-ghc-environment-files" defaultConfigFile+  "-- documentation"  @=? findLineWith True "documentation" defaultConfigFile+  "-- doc-index-file"  @=? findLineWith True "doc-index-file" defaultConfigFile+  "-- only-download"  @=? findLineWith True "only-download" defaultConfigFile+  "-- target-package-db" @=? findLineWith True "target-package-db" defaultConfigFile+  "-- max-backjumps"  @=? findLineWith True "max-backjumps" defaultConfigFile+  "-- reorder-goals"  @=? findLineWith True "reorder-goals" defaultConfigFile+  "-- count-conflicts"  @=? findLineWith True "count-conflicts" defaultConfigFile+  "-- fine-grained-conflicts"  @=? findLineWith True "fine-grained-conflicts" defaultConfigFile+  "-- minimize-conflict-set"  @=? findLineWith True "minimize-conflict-set" defaultConfigFile+  "-- independent-goals"  @=? findLineWith True "independent-goals" defaultConfigFile+  "-- prefer-oldest"  @=? findLineWith True "prefer-oldest" defaultConfigFile+  "-- shadow-installed-packages"  @=? findLineWith True "shadow-installed-packages" defaultConfigFile+  "-- strong-flags"  @=? findLineWith True "strong-flags" defaultConfigFile+  "-- allow-boot-library-installs"  @=? findLineWith True "allow-boot-library-installs" defaultConfigFile+  "-- reject-unconstrained-dependencies"  @=? findLineWith True "reject-unconstrained-dependencies" defaultConfigFile+  "-- reinstall"  @=? findLineWith True "reinstall" defaultConfigFile+  "-- avoid-reinstalls"  @=? findLineWith True "avoid-reinstalls" defaultConfigFile+  "-- force-reinstalls"  @=? findLineWith True "force-reinstalls" defaultConfigFile+  "-- upgrade-dependencies"  @=? findLineWith True "upgrade-dependencies" defaultConfigFile+  "-- index-state" @=? findLineWith True "index-state" defaultConfigFile+  "-- root-cmd" @=? findLineWith True "root-cmd" defaultConfigFile+  "-- symlink-bindir" @=? findLineWith True "symlink-bindir" defaultConfigFile+  "build-summary"  @=? findLineWith False "build-summary" defaultConfigFile+  "-- build-log" @=? findLineWith True "build-log" defaultConfigFile+  "remote-build-reporting"  @=? findLineWith False "remote-build-reporting" defaultConfigFile+  "-- report-planning-failure"  @=? findLineWith True "report-planning-failure" defaultConfigFile+  "-- per-component"  @=? findLineWith True "per-component" defaultConfigFile+  "-- run-tests" @=? findLineWith True "run-tests" defaultConfigFile+  "jobs"  @=? findLineWith False "jobs" defaultConfigFile+  "-- keep-going"  @=? findLineWith True "keep-going" defaultConfigFile+  "-- offline"  @=? findLineWith True "offline" defaultConfigFile+  "-- lib" @=? findLineWith True "lib" defaultConfigFile+  "-- package-env" @=? findLineWith True "package-env" defaultConfigFile+  "-- overwrite-policy" @=? findLineWith True "overwrite-policy" defaultConfigFile+  "-- install-method" @=? findLineWith True "install-method" defaultConfigFile+  "installdir"  @=? findLineWith False "installdir" defaultConfigFile+  "-- username" @=? findLineWith True "username" defaultConfigFile+  "-- password" @=? findLineWith True "password" defaultConfigFile+  "-- password-command" @=? findLineWith True "password-command" defaultConfigFile+  "-- builddir" @=? findLineWith True "builddir" defaultConfigFile++  "  -- keep-temp-files" @=? findLineWith True "keep-temp-files" defaultConfigFile+  "  -- hoogle" @=? findLineWith True "hoogle" defaultConfigFile+  "  -- html" @=? findLineWith True "html" defaultConfigFile+  "  -- html-location" @=? findLineWith True "html-location" defaultConfigFile+  "  -- executables" @=? findLineWith True "executables" defaultConfigFile+  "  -- foreign-libraries" @=? findLineWith True "foreign-libraries" defaultConfigFile+  "  -- all" @=? findLineWith True "all" defaultConfigFile+  "  -- internal" @=? findLineWith True "internal" defaultConfigFile+  "  -- css" @=? findLineWith True "css" defaultConfigFile+  "  -- hyperlink-source" @=? findLineWith True "hyperlink-source" defaultConfigFile+  "  -- quickjump" @=? findLineWith True "quickjump" defaultConfigFile+  "  -- hscolour-css" @=? findLineWith True "hscolour-css" defaultConfigFile+  "  -- contents-location" @=? findLineWith True "contents-location" defaultConfigFile+  "  -- index-location" @=? findLineWith True "index-location" defaultConfigFile+  "  -- base-url" @=? findLineWith True "base-url" defaultConfigFile++  "  -- interactive" @=? findLineWith True "interactive" defaultConfigFile+  "  -- cabal-version" @=? findLineWith True "cabal-version" defaultConfigFile+  "  -- license" @=? findLineWith True "license" defaultConfigFile+  "  -- extra-doc-file" @=? findLineWith True "extra-doc-file" defaultConfigFile+  "  -- test-dir" @=? findLineWith True "test-dir" defaultConfigFile+  "  -- language" @=? findLineWith True "language" defaultConfigFile+  "  -- application-dir" @=? findLineWith True "application-dir" defaultConfigFile+  "  -- source-dir" @=? findLineWith True "source-dir" defaultConfigFile++  "  -- prefix"  @=? findLineWith True "prefix" defaultConfigFile+  "  -- bindir"@=? findLineWith True "bindir" defaultConfigFile+  "  -- libdir" @=? findLineWith True "libdir" defaultConfigFile+  "  -- libsubdir" @=? findLineWith True "libsubdir" defaultConfigFile+  "  -- dynlibdir" @=? findLineWith True "dynlibdir" defaultConfigFile+  "  -- libexecdir" @=? findLineWith True "libexecdir" defaultConfigFile+  "  -- libexecsubdir" @=? findLineWith True "libexecsubdir" defaultConfigFile+  "  -- datadir" @=? findLineWith True "datadir" defaultConfigFile+  "  -- datasubdir" @=? findLineWith True "datasubdir" defaultConfigFile+  "  -- docdir" @=? findLineWith True "docdir" defaultConfigFile+  "  -- htmldir" @=? findLineWith True "htmldir" defaultConfigFile+  "  -- haddockdir" @=? findLineWith True "haddockdir" defaultConfigFile+  "  -- sysconfdir" @=? findLineWith True "sysconfdir" defaultConfigFile++  "  -- alex-location" @=? findLineWith True "alex-location" defaultConfigFile+  "  -- ar-location" @=? findLineWith True "ar-location" defaultConfigFile+  "  -- c2hs-location" @=? findLineWith True "c2hs-location" defaultConfigFile+  "  -- cpphs-location" @=? findLineWith True "cpphs-location" defaultConfigFile+  "  -- doctest-location" @=? findLineWith True "doctest-location" defaultConfigFile+  "  -- gcc-location" @=? findLineWith True "gcc-location" defaultConfigFile+  "  -- ghc-location" @=? findLineWith True "ghc-location" defaultConfigFile+  "  -- ghc-pkg-location" @=? findLineWith True "ghc-pkg-location" defaultConfigFile+  "  -- ghcjs-location" @=? findLineWith True "ghcjs-location" defaultConfigFile+  "  -- ghcjs-pkg-location" @=? findLineWith True "ghcjs-pkg-location" defaultConfigFile+  "  -- greencard-location" @=? findLineWith True "greencard-location" defaultConfigFile+  "  -- haddock-location" @=? findLineWith True "haddock-location" defaultConfigFile+  "  -- happy-location" @=? findLineWith True "happy-location" defaultConfigFile+  "  -- haskell-suite-location" @=? findLineWith True "haskell-suite-location" defaultConfigFile+  "  -- haskell-suite-pkg-location" @=? findLineWith True "haskell-suite-pkg-location" defaultConfigFile+  "  -- hmake-location" @=? findLineWith True "hmake-location" defaultConfigFile+  "  -- hpc-location" @=? findLineWith True "hpc-location" defaultConfigFile+  "  -- hscolour-location" @=? findLineWith True "hscolour-location" defaultConfigFile+  "  -- jhc-location" @=? findLineWith True "jhc-location" defaultConfigFile+  "  -- ld-location" @=? findLineWith True "ld-location" defaultConfigFile+  "  -- pkg-config-location" @=? findLineWith True "pkg-config-location" defaultConfigFile+  "  -- runghc-location" @=? findLineWith True "runghc-location" defaultConfigFile+  "  -- strip-location" @=? findLineWith True "strip-location" defaultConfigFile+  "  -- tar-location" @=? findLineWith True "tar-location" defaultConfigFile+  "  -- uhc-location" @=? findLineWith True "uhc-location" defaultConfigFile++  "  -- alex-options" @=? findLineWith True "alex-options" defaultConfigFile+  "  -- ar-options" @=? findLineWith True "ar-options" defaultConfigFile+  "  -- c2hs-options" @=? findLineWith True "c2hs-options" defaultConfigFile+  "  -- cpphs-options" @=? findLineWith True "cpphs-options" defaultConfigFile+  "  -- doctest-options" @=? findLineWith True "doctest-options" defaultConfigFile+  "  -- gcc-options" @=? findLineWith True "gcc-options" defaultConfigFile+  "  -- ghc-options" @=? findLineWith True "ghc-options" defaultConfigFile+  "  -- ghc-pkg-options" @=? findLineWith True "ghc-pkg-options" defaultConfigFile+  "  -- ghcjs-options" @=? findLineWith True "ghcjs-options" defaultConfigFile+  "  -- ghcjs-pkg-options" @=? findLineWith True "ghcjs-pkg-options" defaultConfigFile+  "  -- greencard-options" @=? findLineWith True "greencard-options" defaultConfigFile+  "  -- haddock-options" @=? findLineWith True "haddock-options" defaultConfigFile+  "  -- happy-options" @=? findLineWith True "happy-options" defaultConfigFile+  "  -- haskell-suite-options" @=? findLineWith True "haskell-suite-options" defaultConfigFile+  "  -- haskell-suite-pkg-options" @=? findLineWith True "haskell-suite-pkg-options" defaultConfigFile+  "  -- hmake-options" @=? findLineWith True "hmake-options" defaultConfigFile+  "  -- hpc-options" @=? findLineWith True "hpc-options" defaultConfigFile+  "  -- hsc2hs-options" @=? findLineWith True "hsc2hs-options" defaultConfigFile+  "  -- hscolour-options" @=? findLineWith True "hscolour-options" defaultConfigFile+  "  -- jhc-options" @=? findLineWith True "jhc-options" defaultConfigFile+  "  -- ld-options" @=? findLineWith True "ld-options" defaultConfigFile+  "  -- pkg-config-options" @=? findLineWith True "pkg-config-options" defaultConfigFile+  "  -- runghc-options" @=? findLineWith True "runghc-options" defaultConfigFile+  "  -- strip-options" @=? findLineWith True "strip-options" defaultConfigFile+  "  -- tar-options" @=? findLineWith True "tar-options" defaultConfigFile+  "  -- uhc-options" @=? findLineWith True "uhc-options" defaultConfigFile+  where+    -- | Find lines containing a target string.+    findLineWith :: Bool -> String -> String -> String+    findLineWith isComment target text+      | not . null $ findLinesWith isComment target text = removeCommentValue . L.head $ findLinesWith isComment target text+      | otherwise  = text+    findLinesWith :: Bool -> String -> String -> [String]+    findLinesWith isComment target+      | isComment = filter (isInfixOf (" " ++ target ++ ":")) . lines+      | otherwise = filter (isInfixOf (target ++ ":")) . lines+    removeCommentValue :: String -> String+    removeCommentValue = takeWhile (/= ':')  testIgnoreProjectFlag :: Assertion testIgnoreProjectFlag = do

@@ -44,7 +44,7 @@ import Data.Coerce                      (Coercible, coerce) import Network.URI                      (URI (..), URIAuth (..), isUnreserved) import Test.QuickCheck-import Test.QuickCheck.GenericArbitrary+import Test.QuickCheck.GenericArbitrary (genericArbitrary) import Test.QuickCheck.Instances.Cabal ()  -- note: there are plenty of instances defined in ProjectConfig test file.@@ -106,11 +106,6 @@ ------------------------------------------------------------------------------- -- cabal-install (and Cabal) types ---------------------------------------------------------------------------------shrinkBoundedEnum :: (Eq a, Enum a, Bounded a) => a -> [a]-shrinkBoundedEnum x-    | x == minBound = []-    | otherwise     = [pred x]  adjustSize :: (Int -> Int) -> Gen a -> Gen a adjustSize adjust gen = sized (\n -> resize (adjust n) gen)

@@ -44,7 +44,9 @@               }             inputs =               -- createProject stuff-              [ "True"+              [ "Foobar"+              , "foobar@qux.com"+              , "True"               , "[\"quxTest/Main.hs\"]"               -- writeProject stuff               -- writeLicense

@@ -73,7 +73,9 @@               , dependencies = Flag []               }             inputs = NEL.fromList-              [ "True"+              ["Foobar"+              , "foobar@qux.com"+              , "True"               , "[\"quxTest/Main.hs\"]"               ] @@ -149,8 +151,11 @@               , dependencies = Flag []               }             inputs = NEL.fromList++              [ "Foobar"+              , "foobar@qux.com"               -- extra sources-              [ "[\"CHANGELOG.md\"]"+              , "[\"CHANGELOG.md\"]"               -- lib other modules               , "False"               -- exe other modules

@@ -155,10 +155,6 @@                       solverSuccess [("base", 1), ("ghc-prim", 1), ("integer-gmp", 1), ("integer-simple", 1)]         , runTest $ mkTest dbNonupgrade "Refuse to install newer ghc requested by another library" ["A"] $                       solverFailure (isInfixOf "rejecting: ghc-2.0.0 (constraint from non-upgradeable package requires installed instance)")-        , runTest $ mkTest dbNonupgrade "Refuse to install newer ghci requested by another library" ["B"] $-                      solverFailure (isInfixOf "rejecting: ghci-2.0.0 (constraint from non-upgradeable package requires installed instance)")-        , runTest $ mkTest dbNonupgrade "Refuse to install newer ghc-boot requested by another library" ["C"] $-                      solverFailure (isInfixOf "rejecting: ghc-boot-2.0.0 (constraint from non-upgradeable package requires installed instance)")         ]     , testGroup "reject-unconstrained" [           runTest $ onlyConstrained $ mkTest db12 "missing syb" ["E"] $@@ -1132,14 +1128,8 @@ dbNonupgrade :: ExampleDb dbNonupgrade = [     Left $ exInst "ghc" 1 "ghc-1" []-  , Left $ exInst "ghci" 1 "ghci-1" []-  , Left $ exInst "ghc-boot" 1 "ghc-boot-1" []   , Right $ exAv "ghc" 2 []-  , Right $ exAv "ghci" 2 []-  , Right $ exAv "ghc-boot" 2 []   , Right $ exAv "A" 1 [ExFix "ghc" 2]-  , Right $ exAv "B" 1 [ExFix "ghci" 2]-  , Right $ exAv "C" 1 [ExFix "ghc-boot" 2]   ]  db13 :: ExampleDb