diff --git a/Distribution/Client/Config.hs b/Distribution/Client/Config.hs --- a/Distribution/Client/Config.hs +++ b/Distribution/Client/Config.hs @@ -139,17 +139,214 @@ savedHaddockFlags = mempty } mappend a b = SavedConfig { - savedGlobalFlags = combine savedGlobalFlags, - savedInstallFlags = combine savedInstallFlags, - savedConfigureFlags = combine savedConfigureFlags, - savedConfigureExFlags = combine savedConfigureExFlags, - savedUserInstallDirs = combine savedUserInstallDirs, - savedGlobalInstallDirs = combine savedGlobalInstallDirs, - savedUploadFlags = combine savedUploadFlags, - savedReportFlags = combine savedReportFlags, - savedHaddockFlags = combine savedHaddockFlags + savedGlobalFlags = combinedSavedGlobalFlags, + savedInstallFlags = combinedSavedInstallFlags, + savedConfigureFlags = combinedSavedConfigureFlags, + savedConfigureExFlags = combinedSavedConfigureExFlags, + savedUserInstallDirs = combinedSavedUserInstallDirs, + savedGlobalInstallDirs = combinedSavedGlobalInstallDirs, + savedUploadFlags = combinedSavedUploadFlags, + savedReportFlags = combinedSavedReportFlags, + savedHaddockFlags = combinedSavedHaddockFlags } - where combine field = field a `mappend` field b + where + -- This is ugly, but necessary. If we're mappending two config files, we + -- want the values of the *non-empty* list fields from the second one to + -- *override* the corresponding values from the first one. Default + -- behaviour (concatenation) is confusing and makes some use cases (see + -- #1884) impossible. + -- + -- However, we also want to allow specifying multiple values for a list + -- field in a *single* config file. For example, we want the following to + -- continue to work: + -- + -- remote-repo: hackage.haskell.org:http://hackage.haskell.org/ + -- remote-repo: private-collection:http://hackage.local/ + -- + -- So we can't just wrap the list fields inside Flags; we have to do some + -- special-casing just for SavedConfig. + + -- NB: the signature prevents us from using 'combine' on lists. + combine' :: (SavedConfig -> flags) -> (flags -> Flag a) -> Flag a + combine' field subfield = + (subfield . field $ a) `mappend` (subfield . field $ b) + + lastNonEmpty' :: (SavedConfig -> flags) -> (flags -> [a]) -> [a] + lastNonEmpty' field subfield = + let a' = subfield . field $ a + b' = subfield . field $ b + in case b' of [] -> a' + _ -> b' + + lastNonEmptyNL' :: (SavedConfig -> flags) -> (flags -> [a]) + -> [a] + lastNonEmptyNL' field subfield = + let a' = subfield . field $ a + b' = subfield . field $ b + in case b' of [] -> a' + _ -> b' + + combinedSavedGlobalFlags = GlobalFlags { + globalVersion = combine globalVersion, + globalNumericVersion = combine globalNumericVersion, + globalConfigFile = combine globalConfigFile, + globalSandboxConfigFile = combine globalSandboxConfigFile, + globalRemoteRepos = lastNonEmptyNL globalRemoteRepos, + globalCacheDir = combine globalCacheDir, + globalLocalRepos = lastNonEmptyNL globalLocalRepos, + globalLogsDir = combine globalLogsDir, + globalWorldFile = combine globalWorldFile, + globalRequireSandbox = combine globalRequireSandbox, + globalIgnoreSandbox = combine globalIgnoreSandbox + } + where + combine = combine' savedGlobalFlags + lastNonEmptyNL = lastNonEmptyNL' savedGlobalFlags + + combinedSavedInstallFlags = InstallFlags { + installDocumentation = combine installDocumentation, + installHaddockIndex = combine installHaddockIndex, + installDryRun = combine installDryRun, + installMaxBackjumps = combine installMaxBackjumps, + installReorderGoals = combine installReorderGoals, + installIndependentGoals = combine installIndependentGoals, + installShadowPkgs = combine installShadowPkgs, + installStrongFlags = combine installStrongFlags, + installReinstall = combine installReinstall, + installAvoidReinstalls = combine installAvoidReinstalls, + installOverrideReinstall = combine installOverrideReinstall, + installUpgradeDeps = combine installUpgradeDeps, + installOnly = combine installOnly, + installOnlyDeps = combine installOnlyDeps, + installRootCmd = combine installRootCmd, + installSummaryFile = lastNonEmptyNL installSummaryFile, + installLogFile = combine installLogFile, + installBuildReports = combine installBuildReports, + installSymlinkBinDir = combine installSymlinkBinDir, + installOneShot = combine installOneShot, + installNumJobs = combine installNumJobs, + installRunTests = combine installRunTests + } + where + combine = combine' savedInstallFlags + lastNonEmptyNL = lastNonEmptyNL' savedInstallFlags + + combinedSavedConfigureFlags = ConfigFlags { + configPrograms = configPrograms . savedConfigureFlags $ b, + -- TODO: NubListify + configProgramPaths = lastNonEmpty configProgramPaths, + -- TODO: NubListify + configProgramArgs = lastNonEmpty configProgramArgs, + configProgramPathExtra = lastNonEmptyNL configProgramPathExtra, + configHcFlavor = combine configHcFlavor, + configHcPath = combine configHcPath, + configHcPkg = combine configHcPkg, + configVanillaLib = combine configVanillaLib, + configProfLib = combine configProfLib, + configSharedLib = combine configSharedLib, + configDynExe = combine configDynExe, + configProfExe = combine configProfExe, + -- TODO: NubListify + configConfigureArgs = lastNonEmpty configConfigureArgs, + configOptimization = combine configOptimization, + configProgPrefix = combine configProgPrefix, + configProgSuffix = combine configProgSuffix, + -- Parametrised by (Flag PathTemplate), so safe to use 'mappend'. + configInstallDirs = + (configInstallDirs . savedConfigureFlags $ a) + `mappend` (configInstallDirs . savedConfigureFlags $ b), + configScratchDir = combine configScratchDir, + -- TODO: NubListify + configExtraLibDirs = lastNonEmpty configExtraLibDirs, + -- TODO: NubListify + configExtraIncludeDirs = lastNonEmpty configExtraIncludeDirs, + configDistPref = combine configDistPref, + configVerbosity = combine configVerbosity, + configUserInstall = combine configUserInstall, + -- TODO: NubListify + configPackageDBs = lastNonEmpty configPackageDBs, + configGHCiLib = combine configGHCiLib, + configSplitObjs = combine configSplitObjs, + configStripExes = combine configStripExes, + configStripLibs = combine configStripLibs, + -- TODO: NubListify + configConstraints = lastNonEmpty configConstraints, + -- TODO: NubListify + configDependencies = lastNonEmpty configDependencies, + -- TODO: NubListify + configConfigurationsFlags = lastNonEmpty configConfigurationsFlags, + configTests = combine configTests, + configBenchmarks = combine configBenchmarks, + configLibCoverage = combine configLibCoverage, + configExactConfiguration = combine configExactConfiguration + } + where + combine = combine' savedConfigureFlags + lastNonEmpty = lastNonEmpty' savedConfigureFlags + lastNonEmptyNL = lastNonEmptyNL' savedConfigureFlags + + combinedSavedConfigureExFlags = ConfigExFlags { + configCabalVersion = combine configCabalVersion, + -- TODO: NubListify + configExConstraints = lastNonEmpty configExConstraints, + -- TODO: NubListify + configPreferences = lastNonEmpty configPreferences, + configSolver = combine configSolver, + configAllowNewer = combine configAllowNewer + } + where + combine = combine' savedConfigureExFlags + lastNonEmpty = lastNonEmpty' savedConfigureExFlags + + -- Parametrised by (Flag PathTemplate), so safe to use 'mappend'. + combinedSavedUserInstallDirs = savedUserInstallDirs a + `mappend` savedUserInstallDirs b + + -- Parametrised by (Flag PathTemplate), so safe to use 'mappend'. + combinedSavedGlobalInstallDirs = savedGlobalInstallDirs a + `mappend` savedGlobalInstallDirs b + + combinedSavedUploadFlags = UploadFlags { + uploadCheck = combine uploadCheck, + uploadUsername = combine uploadUsername, + uploadPassword = combine uploadPassword, + uploadVerbosity = combine uploadVerbosity + } + where + combine = combine' savedUploadFlags + + combinedSavedReportFlags = ReportFlags { + reportUsername = combine reportUsername, + reportPassword = combine reportPassword, + reportVerbosity = combine reportVerbosity + } + where + combine = combine' savedReportFlags + + combinedSavedHaddockFlags = HaddockFlags { + -- TODO: NubListify + haddockProgramPaths = lastNonEmpty haddockProgramPaths, + -- TODO: NubListify + haddockProgramArgs = lastNonEmpty haddockProgramArgs, + haddockHoogle = combine haddockHoogle, + haddockHtml = combine haddockHtml, + haddockHtmlLocation = combine haddockHtmlLocation, + haddockExecutables = combine haddockExecutables, + haddockTestSuites = combine haddockTestSuites, + haddockBenchmarks = combine haddockBenchmarks, + haddockInternal = combine haddockInternal, + haddockCss = combine haddockCss, + haddockHscolour = combine haddockHscolour, + haddockHscolourCss = combine haddockHscolourCss, + haddockContents = combine haddockContents, + haddockDistPref = combine haddockDistPref, + haddockKeepTempFiles = combine haddockKeepTempFiles, + haddockVerbosity = combine haddockVerbosity + } + where + combine = combine' savedHaddockFlags + lastNonEmpty = lastNonEmpty' savedHaddockFlags + updateInstallDirs :: Flag Bool -> SavedConfig -> SavedConfig updateInstallDirs userInstallFlag diff --git a/Distribution/Client/Freeze.hs b/Distribution/Client/Freeze.hs --- a/Distribution/Client/Freeze.hs +++ b/Distribution/Client/Freeze.hs @@ -65,12 +65,6 @@ -- * The freeze command -- ------------------------------------------------------------ ---TODO: --- * Don't overwrite all of `cabal.config`, just the constraints section. --- * Should the package represented by `UserTargetLocalDir "."` be --- constrained too? What about `base`? - - -- | Freeze all of the dependencies by writing a constraints section -- constraining each dependency to an exact version. -- @@ -113,10 +107,13 @@ where dryRun = fromFlag (freezeDryRun freezeFlags) - sanityCheck pkgSpecifiers = + sanityCheck pkgSpecifiers = do when (not . null $ [n | n@(NamedPackage _ _) <- pkgSpecifiers]) $ die $ "internal error: 'resolveUserTargets' returned " ++ "unexpected named package specifiers!" + when (length pkgSpecifiers /= 1) $ + die $ "internal error: 'resolveUserTargets' returned " + ++ "unexpected source package specifiers!" planPackages :: Verbosity -> Compiler @@ -173,21 +170,28 @@ -- | Remove all unneeded packages from an install plan. -- --- A package is unneeded if it is not a dependency (directly or --- transitively) of any of the 'PackageSpecifier SourcePackage's. This is --- useful for removing previously installed packages which are no longer --- required from the install plan. +-- A package is unneeded if it is either +-- +-- 1) the package that we are freezing, or +-- +-- 2) not a dependency (directly or transitively) of the package we are +-- freezing. This is useful for removing previously installed packages +-- which are no longer required from the install plan. pruneInstallPlan :: InstallPlan.InstallPlan -> [PackageSpecifier SourcePackage] -> Either [PlanPackage] [(PlanPackage, [PackageIdentifier])] pruneInstallPlan installPlan pkgSpecifiers = - mapLeft PackageIndex.allPackages $ + mapLeft (removeSelf pkgIds . PackageIndex.allPackages) $ PackageIndex.dependencyClosure pkgIdx pkgIds where pkgIdx = PackageIndex.fromList $ InstallPlan.toList installPlan pkgIds = [ packageId pkg | SpecificSourcePackage pkg <- pkgSpecifiers ] mapLeft f (Left v) = Left $ f v mapLeft _ (Right v) = Right v + removeSelf [thisPkg] = filter (\pp -> packageId pp /= thisPkg) + removeSelf _ = + error $ "internal error: 'pruneInstallPlan' given " + ++ "unexpected package specifiers!" freezePackages :: Package pkg => Verbosity -> [pkg] -> IO () diff --git a/Distribution/Client/Install.hs b/Distribution/Client/Install.hs --- a/Distribution/Client/Install.hs +++ b/Distribution/Client/Install.hs @@ -116,7 +116,7 @@ , testCommand, TestFlags(..), emptyTestFlags ) import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose, rawSystemExit, comparing - , writeFileAtomic, withTempFile , withFileContents ) + , writeFileAtomic, withTempFile , withUTF8FileContents ) import Distribution.Simple.InstallDirs as InstallDirs ( PathTemplate, fromPathTemplate, toPathTemplate, substPathTemplate , initialPathTemplateEnv, installDirsTemplateEnv ) @@ -1345,7 +1345,7 @@ Cabal.regGenPkgConf = toFlag (Just pkgConfFile) } setup Cabal.registerCommand registerFlags' mLogPath - withFileContents pkgConfFile $ \pkgConfText -> + withUTF8FileContents pkgConfFile $ \pkgConfText -> case Installed.parseInstalledPackageInfo pkgConfText of Installed.ParseFailed perror -> pkgConfParseFailed perror Installed.ParseOk warns pkgConf -> do diff --git a/Distribution/Client/SrcDist.hs b/Distribution/Client/SrcDist.hs --- a/Distribution/Client/SrcDist.hs +++ b/Distribution/Client/SrcDist.hs @@ -29,7 +29,7 @@ import Distribution.Simple.Program (requireProgram, simpleProgram, programPath) import Distribution.Simple.Program.Db (emptyProgramDb) import Distribution.Text ( display ) -import Distribution.Verbosity (Verbosity, lessVerbose, normal) +import Distribution.Verbosity (Verbosity) import Distribution.Version (Version(..), orLaterVersion) import System.FilePath ((), (<.>)) @@ -53,9 +53,6 @@ let outDir = if isOutDirectory then tmpDir else tmpDir tarBallName pkg flags' = (if not needMakeArchive then flags else flags { sDistDirectory = Flag outDir }) - { sDistVerbosity = Flag $ if verbosity == normal - then lessVerbose verbosity - else verbosity } unless isListSources $ createDirectoryIfMissingVerbose verbosity True outDir diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -810,7 +810,7 @@ unless (null extraArgs) $ die $ "'update' doesn't take any extra arguments: " ++ unwords extraArgs let verbosity = fromFlag verbosityFlag - config <- loadConfig verbosity (globalConfigFile globalFlags) mempty + (_useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags NoFlag let globalFlags' = savedGlobalFlags config `mappend` globalFlags update verbosity (globalRepos globalFlags') diff --git a/bootstrap.sh b/bootstrap.sh --- a/bootstrap.sh +++ b/bootstrap.sh @@ -126,7 +126,7 @@ # >= 0.2 && < 1.2 NETWORK_VER="2.4.2.3"; NETWORK_VER_REGEXP="2\.[0-5]\." # >= 2.0 && < 2.6 -CABAL_VER="1.20.0.0"; CABAL_VER_REGEXP="1\.2[01]\." +CABAL_VER="1.20.0.3"; CABAL_VER_REGEXP="1\.2[01]\." # >= 1.20 && < 1.21 TRANS_VER="0.3.0.0"; TRANS_VER_REGEXP="0\.[23]\." # >= 0.2.* && < 0.4.* diff --git a/cabal-install.cabal b/cabal-install.cabal --- a/cabal-install.cabal +++ b/cabal-install.cabal @@ -1,5 +1,5 @@ Name: cabal-install -Version: 1.20.0.3 +Version: 1.20.0.4 Synopsis: The command-line interface for Cabal and Hackage. Description: The \'cabal\' command-line program simplifies the process of managing @@ -34,6 +34,10 @@ description: Use directory < 1.2 and old-time default: False +flag network-uri + description: Get Network.URI from the network-uri package + default: True + executable cabal main-is: Main.hs ghc-options: -Wall -fwarn-tabs @@ -125,7 +129,7 @@ filepath >= 1.0 && < 1.4, HTTP >= 4000.2.5 && < 4000.3, mtl >= 2.0 && < 3, - network >= 2.0 && < 2.6, + network >= 2.0 && < 2.7, pretty >= 1 && < 1.2, random >= 1 && < 1.1, stm >= 2.0 && < 3, @@ -138,6 +142,11 @@ else build-depends: directory >= 1.2 && < 1.3, process >= 1.1.0.2 && < 1.3 + + if flag(network-uri) + build-depends: network-uri >= 2.6, network >= 2.6 + else + build-depends: network-uri < 2.6, network < 2.6 if os(windows) build-depends: Win32 >= 2 && < 3