From dea1a8147ad73a0a4a2825197dc7f99e5ef8e85f Mon Sep 17 00:00:00 2001 From: Herbert Valerio Riedel Date: Sun, 29 May 2016 14:08:41 +0200 Subject: [PATCH] Implement `--allow-older` (dual to `--allow-newer`) (re #3466) This implements the flag `--allow-older` which is the analogous to `--allow-newer` acting on lower bounds. --- Cabal/Cabal.cabal | 4 +++ Cabal/Distribution/Simple/Configure.hs | 23 +++++++------ Cabal/Distribution/Simple/Setup.hs | 9 +++++ Cabal/Distribution/Version.hs | 13 +++++++ Cabal/changelog | 1 + Cabal/doc/installing-packages.markdown | 11 ++++-- .../PackageTests/AllowOlder/AllowOlder.cabal | 25 ++++++++++++++ .../AllowOlder/benchmarks/Bench.hs | 4 +++ .../tests/PackageTests/AllowOlder/src/Foo.hs | 4 +++ .../PackageTests/AllowOlder/tests/Test.hs | 4 +++ Cabal/tests/PackageTests/Tests.hs | 25 ++++++++++++++ cabal-install/Distribution/Client/Config.hs | 34 ++++++++++++------- .../Distribution/Client/Configure.hs | 12 ++++--- .../Distribution/Client/Dependency.hs | 30 ++++++++++++---- cabal-install/Distribution/Client/Install.hs | 9 +++-- .../Distribution/Client/ProjectConfig.hs | 4 ++- .../Client/ProjectConfig/Legacy.hs | 12 ++++++- .../Client/ProjectConfig/Types.hs | 4 ++- .../Distribution/Client/ProjectPlanning.hs | 4 ++- cabal-install/Distribution/Client/Setup.hs | 3 +- .../Distribution/Client/ProjectConfig.hs | 11 +++--- 21 files changed, 198 insertions(+), 48 deletions(-) create mode 100644 Cabal/tests/PackageTests/AllowOlder/AllowOlder.cabal create mode 100644 Cabal/tests/PackageTests/AllowOlder/benchmarks/Bench.hs create mode 100644 Cabal/tests/PackageTests/AllowOlder/src/Foo.hs create mode 100644 Cabal/tests/PackageTests/AllowOlder/tests/Test.hs diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 27457061059..284a4b08f58 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -34,6 +34,10 @@ extra-source-files: tests/PackageTests/AllowNewer/benchmarks/Bench.hs tests/PackageTests/AllowNewer/src/Foo.hs tests/PackageTests/AllowNewer/tests/Test.hs + tests/PackageTests/AllowOlder/AllowOlder.cabal + tests/PackageTests/AllowOlder/benchmarks/Bench.hs + tests/PackageTests/AllowOlder/src/Foo.hs + tests/PackageTests/AllowOlder/tests/Test.hs tests/PackageTests/BenchmarkExeV10/Foo.hs tests/PackageTests/BenchmarkExeV10/benchmarks/bench-Foo.hs tests/PackageTests/BenchmarkExeV10/my.cabal diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index 86151ac5fe6..4e70e299c40 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -320,10 +320,12 @@ configure :: (GenericPackageDescription, HookedBuildInfo) -> ConfigFlags -> IO LocalBuildInfo configure (pkg_descr0', pbi) cfg = do let pkg_descr0 = - -- Ignore '--allow-newer' when we're given '--exact-configuration'. + -- Ignore '--allow-{older,newer}' when we're given '--exact-configuration'. if fromFlagOrDefault False (configExactConfiguration cfg) then pkg_descr0' - else relaxPackageDeps + else relaxPackageDeps removeLowerBound + (maybe RelaxDepsNone unAllowOlder $ configAllowOlder cfg) $ + relaxPackageDeps removeUpperBound (maybe RelaxDepsNone unAllowNewer $ configAllowNewer cfg) pkg_descr0' @@ -871,14 +873,15 @@ dependencySatisfiable $ PackageIndex.lookupDependency internalPackageSet d -- | Relax the dependencies of this package if needed. -relaxPackageDeps :: RelaxDeps -> GenericPackageDescription - -> GenericPackageDescription -relaxPackageDeps RelaxDepsNone gpd = gpd -relaxPackageDeps RelaxDepsAll gpd = transformAllBuildDepends relaxAll gpd +relaxPackageDeps :: (VersionRange -> VersionRange) + -> RelaxDeps + -> GenericPackageDescription -> GenericPackageDescription +relaxPackageDeps _ RelaxDepsNone gpd = gpd +relaxPackageDeps vrtrans RelaxDepsAll gpd = transformAllBuildDepends relaxAll gpd where relaxAll = \(Dependency pkgName verRange) -> - Dependency pkgName (removeUpperBound verRange) -relaxPackageDeps (RelaxDepsSome allowNewerDeps') gpd = + Dependency pkgName (vrtrans verRange) +relaxPackageDeps vrtrans (RelaxDepsSome allowNewerDeps') gpd = transformAllBuildDepends relaxSome gpd where thisPkgName = packageName gpd @@ -886,11 +889,11 @@ relaxPackageDeps (RelaxDepsSome allowNewerDeps') gpd = f (Setup.RelaxedDep p) = Just p f (Setup.RelaxedDepScoped scope p) | scope == thisPkgName = Just p - | otherwise = Nothing + | otherwise = Nothing relaxSome = \d@(Dependency depName verRange) -> if depName `elem` allowNewerDeps - then Dependency depName (removeUpperBound verRange) + then Dependency depName (vrtrans verRange) else d -- | Finalize a generic package description. The workhorse is diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index 18f6356f258..18c3aaf790f 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/Cabal/Distribution/Simple/Setup.hs @@ -416,6 +416,7 @@ data ConfigFlags = ConfigFlags { -- ^Halt and show an error message indicating an error in flag assignment configRelocatable :: Flag Bool, -- ^ Enable relocatable package built configDebugInfo :: Flag DebugInfoLevel, -- ^ Emit debug info. + configAllowOlder :: Maybe AllowOlder, -- ^ dual to 'configAllowNewer' configAllowNewer :: Maybe AllowNewer -- ^ Ignore upper bounds on all or some dependencies. Wrapped in 'Maybe' to -- distinguish between "default" and "explicitly disabled". @@ -713,6 +714,14 @@ configureOptions showOrParseArgs = configLibCoverage (\v flags -> flags { configLibCoverage = v }) (boolOpt [] []) + ,option [] ["allow-older"] + ("Ignore upper bounds in all dependencies or DEPS") + (fmap unAllowOlder . configAllowOlder) + (\v flags -> flags { configAllowOlder = fmap AllowOlder v}) + (optArg "DEPS" + (readP_to_E ("Cannot parse the list of packages: " ++) relaxDepsParser) + (Just RelaxDepsAll) relaxDepsPrinter) + ,option [] ["allow-newer"] ("Ignore upper bounds in all dependencies or DEPS") (fmap unAllowNewer . configAllowNewer) diff --git a/Cabal/Distribution/Version.hs b/Cabal/Distribution/Version.hs index 9342a71b2c2..9522e7e21c5 100644 --- a/Cabal/Distribution/Version.hs +++ b/Cabal/Distribution/Version.hs @@ -73,6 +73,7 @@ module Distribution.Version ( -- ** Modification removeUpperBound, + removeLowerBound, -- * Version intervals view asVersionIntervals, @@ -301,6 +302,18 @@ removeUpperBound = fromVersionIntervals . relaxLastInterval . toVersionIntervals relaxLastInterval' [(l,_)] = [(l, NoUpperBound)] relaxLastInterval' (i:is) = i : relaxLastInterval' is +-- | Given a version range, remove the lowest lower bound. +-- Example: @(>= 1 && < 3) || (>= 4 && < 5)@ is converted to +-- @(>= 0 && < 3) || (>= 4 && < 5)@. +removeLowerBound :: VersionRange -> VersionRange +removeLowerBound = fromVersionIntervals . relaxHeadInterval . toVersionIntervals + where + relaxHeadInterval (VersionIntervals intervals) = + VersionIntervals (relaxHeadInterval' intervals) + + relaxHeadInterval' [] = [] + relaxHeadInterval' ((_,u):is) = (minLowerBound,u) : is + -- | Fold over the basic syntactic structure of a 'VersionRange'. -- -- This provides a syntactic view of the expression defining the version range. diff --git a/Cabal/changelog b/Cabal/changelog index a3e90a2e6cd..41ef3f43f5b 100644 --- a/Cabal/changelog +++ b/Cabal/changelog @@ -43,6 +43,7 @@ If you only need to test if a component is buildable (i.e., it is marked buildable in the Cabal file) use the new function 'componentBuildable'. + * Add support for `--allow-older` (dual to `--allow-newer`) (#3466) * Improved an error message for process output decoding errors (#3408). diff --git a/Cabal/doc/installing-packages.markdown b/Cabal/doc/installing-packages.markdown index 517593d8124..c95037f56d7 100644 --- a/Cabal/doc/installing-packages.markdown +++ b/Cabal/doc/installing-packages.markdown @@ -954,9 +954,14 @@ be controlled with the following command line options. for libraries it is also saved in the package registration information and used when compiling modules that use the library. -`--allow-newer`[=_pkgs_] -: Selectively relax upper bounds in dependencies without editing the - package description. +`--allow-newer`[=_pkgs_], `--allow-older`[=_pkgs_] +: Selectively relax upper or lower bounds in dependencies without + editing the package description respectively. + + The following description focuses on upper bounds and the + `--allow-newer` flag, but applies analogously to `--allow-older` + and lower bounds. `--allow-newer` and `--allow-older` can be used + at the same time. If you want to install a package A that depends on B >= 1.0 && < 2.0, but you have the version 2.0 of B installed, you can compile A against B 2.0 by diff --git a/Cabal/tests/PackageTests/AllowOlder/AllowOlder.cabal b/Cabal/tests/PackageTests/AllowOlder/AllowOlder.cabal new file mode 100644 index 00000000000..a7367c58a7f --- /dev/null +++ b/Cabal/tests/PackageTests/AllowOlder/AllowOlder.cabal @@ -0,0 +1,25 @@ +name: AllowOlder +version: 0.1.0.0 +license: BSD3 +author: Foo Bar +maintainer: cabal-dev@haskell.org +build-type: Simple +cabal-version: >=1.10 + +library + exposed-modules: Foo + hs-source-dirs: src + build-depends: base > 42 + default-language: Haskell2010 + +test-suite foo-test + type: exitcode-stdio-1.0 + main-is: Test.hs + hs-source-dirs: tests + build-depends: base > 42 + +benchmark foo-bench + type: exitcode-stdio-1.0 + main-is: Bench.hs + hs-source-dirs: benchmarks + build-depends: base > 42 diff --git a/Cabal/tests/PackageTests/AllowOlder/benchmarks/Bench.hs b/Cabal/tests/PackageTests/AllowOlder/benchmarks/Bench.hs new file mode 100644 index 00000000000..d82a4bd93b7 --- /dev/null +++ b/Cabal/tests/PackageTests/AllowOlder/benchmarks/Bench.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = return () diff --git a/Cabal/tests/PackageTests/AllowOlder/src/Foo.hs b/Cabal/tests/PackageTests/AllowOlder/src/Foo.hs new file mode 100644 index 00000000000..d82a4bd93b7 --- /dev/null +++ b/Cabal/tests/PackageTests/AllowOlder/src/Foo.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = return () diff --git a/Cabal/tests/PackageTests/AllowOlder/tests/Test.hs b/Cabal/tests/PackageTests/AllowOlder/tests/Test.hs new file mode 100644 index 00000000000..d82a4bd93b7 --- /dev/null +++ b/Cabal/tests/PackageTests/AllowOlder/tests/Test.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = return () diff --git a/Cabal/tests/PackageTests/Tests.hs b/Cabal/tests/PackageTests/Tests.hs index f571f5436f3..6a4e73a986a 100644 --- a/Cabal/tests/PackageTests/Tests.hs +++ b/Cabal/tests/PackageTests/Tests.hs @@ -261,6 +261,31 @@ tests config = do ,"--allow-newer=Foo:base" ,"--enable-tests", "--enable-benchmarks"] + -- Test that '--allow-older' works via the 'Setup.hs configure' interface. + tc "AllowOlder" $ do + shouldFail $ cabal "configure" [] + cabal "configure" ["--allow-older"] + shouldFail $ cabal "configure" ["--allow-older=baz,quux"] + cabal "configure" ["--allow-older=base", "--allow-older=baz,quux"] + cabal "configure" ["--allow-older=bar", "--allow-older=base,baz" + ,"--allow-older=quux"] + shouldFail $ cabal "configure" ["--enable-tests"] + cabal "configure" ["--enable-tests", "--allow-older"] + shouldFail $ cabal "configure" ["--enable-benchmarks"] + cabal "configure" ["--enable-benchmarks", "--allow-older"] + shouldFail $ cabal "configure" ["--enable-benchmarks", "--enable-tests"] + cabal "configure" ["--enable-benchmarks", "--enable-tests" + ,"--allow-older"] + shouldFail $ cabal "configure" ["--allow-older=Foo:base"] + shouldFail $ cabal "configure" ["--allow-older=Foo:base" + ,"--enable-tests", "--enable-benchmarks"] + cabal "configure" ["--allow-older=AllowOlder:base"] + cabal "configure" ["--allow-older=AllowOlder:base" + ,"--allow-older=Foo:base"] + cabal "configure" ["--allow-older=AllowOlder:base" + ,"--allow-older=Foo:base" + ,"--enable-tests", "--enable-benchmarks"] + -- Test that Cabal can choose flags to disable building a component when that -- component's dependencies are unavailable. The build should succeed without -- requiring the component's dependencies or imports. diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs index 6cce50b2e6b..ef433ee08cf 100644 --- a/cabal-install/Distribution/Client/Config.hs +++ b/cabal-install/Distribution/Client/Config.hs @@ -62,7 +62,7 @@ import Distribution.Simple.Compiler ( DebugInfoLevel(..), OptimisationLevel(..) ) import Distribution.Simple.Setup ( ConfigFlags(..), configureOptions, defaultConfigFlags - , AllowNewer(..), RelaxDeps(..) + , AllowNewer(..), AllowOlder(..), RelaxDeps(..) , HaddockFlags(..), haddockOptions, defaultHaddockFlags , installDirsOptions, optionDistPref , programConfigurationPaths', programConfigurationOptions @@ -323,6 +323,8 @@ instance Semigroup SavedConfig where configExactConfiguration = combine configExactConfiguration, configFlagError = combine configFlagError, configRelocatable = combine configRelocatable, + configAllowOlder = combineMonoid savedConfigureFlags + configAllowOlder, configAllowNewer = combineMonoid savedConfigureFlags configAllowNewer } @@ -631,7 +633,8 @@ commentSavedConfig = do savedConfigureExFlags = defaultConfigExFlags, savedConfigureFlags = (defaultConfigFlags defaultProgramConfiguration) { configUserInstall = toFlag defaultUserInstall, - configAllowNewer = Just (AllowNewer RelaxDepsNone) + configAllowNewer = Just (AllowNewer RelaxDepsNone), + configAllowOlder = Just (AllowOlder RelaxDepsNone) }, savedUserInstallDirs = fmap toFlag userInstallDirs, savedGlobalInstallDirs = fmap toFlag globalInstallDirs, @@ -660,17 +663,15 @@ configFieldDescriptions src = [simpleField "compiler" (fromFlagOrDefault Disp.empty . fmap Text.disp) (optional Text.parse) configHcFlavor (\v flags -> flags { configHcFlavor = v }) - ,let showAllowNewer Nothing = mempty - showAllowNewer (Just (AllowNewer RelaxDepsNone)) = Disp.text "False" - showAllowNewer (Just _) = Disp.text "True" - - toAllowNewer True = Just (AllowNewer RelaxDepsAll) - toAllowNewer False = Just (AllowNewer RelaxDepsNone) - - pkgs = (Just . AllowNewer . RelaxDepsSome) `fmap` parseOptCommaList Text.parse - parseAllowNewer = (toAllowNewer `fmap` Text.parse) Parse.<++ pkgs in + ,let pkgs = (Just . AllowOlder . RelaxDepsSome) `fmap` parseOptCommaList Text.parse + parseAllowOlder = ((Just . AllowOlder . toRelaxDeps) `fmap` Text.parse) Parse.<++ pkgs in + simpleField "allow-older" + (showRelaxDeps . fmap unAllowOlder) parseAllowOlder + configAllowOlder (\v flags -> flags { configAllowOlder = v }) + ,let pkgs = (Just . AllowNewer . RelaxDepsSome) `fmap` parseOptCommaList Text.parse + parseAllowNewer = ((Just . AllowNewer . toRelaxDeps) `fmap` Text.parse) Parse.<++ pkgs in simpleField "allow-newer" - showAllowNewer parseAllowNewer + (showRelaxDeps . fmap unAllowNewer) parseAllowNewer configAllowNewer (\v flags -> flags { configAllowNewer = v }) -- TODO: The following is a temporary fix. The "optimization" -- and "debug-info" fields are OptArg, and viewAsFieldDescr @@ -770,6 +771,15 @@ configFieldDescriptions src = , name `notElem` exclusions ] optional = Parse.option mempty . fmap toFlag + + showRelaxDeps Nothing = mempty + showRelaxDeps (Just RelaxDepsNone) = Disp.text "False" + showRelaxDeps (Just _) = Disp.text "True" + + toRelaxDeps True = RelaxDepsAll + toRelaxDeps False = RelaxDepsNone + + -- TODO: next step, make the deprecated fields elicit a warning. -- deprecatedFieldDescriptions :: [FieldDescr SavedConfig] diff --git a/cabal-install/Distribution/Client/Configure.hs b/cabal-install/Distribution/Client/Configure.hs index aaf77db405e..57f681ed90a 100644 --- a/cabal-install/Distribution/Client/Configure.hs +++ b/cabal-install/Distribution/Client/Configure.hs @@ -48,7 +48,7 @@ import Distribution.Simple.Compiler ( Compiler, CompilerInfo, compilerInfo, PackageDB(..), PackageDBStack ) import Distribution.Simple.Program (ProgramConfiguration ) import Distribution.Simple.Setup - ( ConfigFlags(..), AllowNewer(..), RelaxDeps(..) + ( ConfigFlags(..), AllowNewer(..), AllowOlder(..), RelaxDeps(..) , fromFlag, toFlag, flagToMaybe, fromFlagOrDefault ) import Distribution.Simple.PackageIndex ( InstalledPackageIndex, lookupPackageName ) @@ -93,8 +93,10 @@ chooseCabalVersion configFlags maybeVersion = -- for '--allow-newer' to work. allowNewer = isRelaxDeps (maybe RelaxDepsNone unAllowNewer $ configAllowNewer configFlags) + allowOlder = isRelaxDeps + (maybe RelaxDepsNone unAllowOlder $ configAllowOlder configFlags) - defaultVersionRange = if allowNewer + defaultVersionRange = if allowOlder || allowNewer then orLaterVersion (Version [1,19,2] []) else anyVersion @@ -306,8 +308,10 @@ planLocalPackage verbosity comp platform configFlags configExFlags fromFlagOrDefault False $ configBenchmarks configFlags resolverParams = - removeUpperBounds - (maybe RelaxDepsNone unAllowNewer $ configAllowNewer configFlags) + removeLowerBounds + (fromMaybe (AllowOlder RelaxDepsNone) $ configAllowOlder configFlags) + . removeUpperBounds + (fromMaybe (AllowNewer RelaxDepsNone) $ configAllowNewer configFlags) . addPreferences -- preferences from the config file or command line diff --git a/cabal-install/Distribution/Client/Dependency.hs b/cabal-install/Distribution/Client/Dependency.hs index 02d19898f9d..c5c22a71ba3 100644 --- a/cabal-install/Distribution/Client/Dependency.hs +++ b/cabal-install/Distribution/Client/Dependency.hs @@ -60,6 +60,7 @@ module Distribution.Client.Dependency ( hideInstalledPackagesSpecificByUnitId, hideInstalledPackagesSpecificBySourcePackageId, hideInstalledPackagesAllVersions, + removeLowerBounds, removeUpperBounds, addDefaultSetupDependencies, ) where @@ -94,7 +95,8 @@ import Distribution.Client.PackageUtils ( externalBuildDepends ) import Distribution.Version ( Version(..), VersionRange, anyVersion, thisVersion, orLaterVersion - , withinRange, simplifyVersionRange ) + , withinRange, simplifyVersionRange + , removeLowerBound, removeUpperBound ) import Distribution.Compiler ( CompilerInfo(..) ) import Distribution.System @@ -106,7 +108,7 @@ import Distribution.Simple.Utils import Distribution.Simple.Configure ( relaxPackageDeps ) import Distribution.Simple.Setup - ( RelaxDeps(..) ) + ( AllowNewer(..), AllowOlder(..), RelaxDeps(..) ) import Distribution.Text ( display ) import Distribution.Verbosity @@ -414,9 +416,9 @@ hideBrokenInstalledPackages params = -- 'addSourcePackages'. Otherwise, the packages inserted by -- 'addSourcePackages' won't have upper bounds in dependencies relaxed. -- -removeUpperBounds :: RelaxDeps -> DepResolverParams -> DepResolverParams -removeUpperBounds RelaxDepsNone params = params -removeUpperBounds allowNewer params = +removeUpperBounds :: AllowNewer -> DepResolverParams -> DepResolverParams +removeUpperBounds (AllowNewer RelaxDepsNone) params = params +removeUpperBounds (AllowNewer allowNewer) params = params { depResolverSourcePkgIndex = sourcePkgIndex' } @@ -425,7 +427,23 @@ removeUpperBounds allowNewer params = relaxDeps :: UnresolvedSourcePackage -> UnresolvedSourcePackage relaxDeps srcPkg = srcPkg { - packageDescription = relaxPackageDeps allowNewer + packageDescription = relaxPackageDeps removeUpperBound allowNewer + (packageDescription srcPkg) + } + +-- | Dual of 'removeUpperBounds' +removeLowerBounds :: AllowOlder -> DepResolverParams -> DepResolverParams +removeLowerBounds (AllowOlder RelaxDepsNone) params = params +removeLowerBounds (AllowOlder allowNewer) params = + params { + depResolverSourcePkgIndex = sourcePkgIndex' + } + where + sourcePkgIndex' = fmap relaxDeps $ depResolverSourcePkgIndex params + + relaxDeps :: UnresolvedSourcePackage -> UnresolvedSourcePackage + relaxDeps srcPkg = srcPkg { + packageDescription = relaxPackageDeps removeLowerBound allowNewer (packageDescription srcPkg) } diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index dde628d7695..b2e51cf3ffd 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -132,7 +132,7 @@ import Distribution.Simple.PackageIndex (InstalledPackageIndex) import Distribution.Simple.Setup ( haddockCommand, HaddockFlags(..) , buildCommand, BuildFlags(..), emptyBuildFlags - , AllowNewer(..), RelaxDeps(..) + , AllowNewer(..), AllowOlder(..), RelaxDeps(..) , toFlag, fromFlag, fromFlagOrDefault, flagToMaybe, defaultDistPref ) import qualified Distribution.Simple.Setup as Cabal ( Flag(..) @@ -395,6 +395,7 @@ planPackages comp platform mSandboxPkgInfo solver . setPreferenceDefault (if upgradeDeps then PreferAllLatest else PreferLatestForSelected) + . removeLowerBounds allowOlder . removeUpperBounds allowNewer . addPreferences @@ -446,8 +447,10 @@ planPackages comp platform mSandboxPkgInfo solver maxBackjumps = fromFlag (installMaxBackjumps installFlags) upgradeDeps = fromFlag (installUpgradeDeps installFlags) onlyDeps = fromFlag (installOnlyDeps installFlags) - allowNewer = maybe RelaxDepsNone unAllowNewer - (configAllowNewer configFlags) + allowOlder = fromMaybe (AllowOlder RelaxDepsNone) + (configAllowOlder configFlags) + allowNewer = fromMaybe (AllowNewer RelaxDepsNone) + (configAllowNewer configFlags) -- | Remove the provided targets from the install plan. pruneInstallPlan :: Package targetpkg diff --git a/cabal-install/Distribution/Client/ProjectConfig.hs b/cabal-install/Distribution/Client/ProjectConfig.hs index b45169bec77..deb732644fc 100644 --- a/cabal-install/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/Distribution/Client/ProjectConfig.hs @@ -75,7 +75,7 @@ import Distribution.Simple.Program ( ConfiguredProgram(..) ) import Distribution.Simple.Setup ( Flag(Flag), toFlag, flagToMaybe, flagToList - , fromFlag, AllowNewer(..), RelaxDeps(..) ) + , fromFlag, AllowNewer(..), AllowOlder(..), RelaxDeps(..) ) import Distribution.Client.Setup ( defaultSolver, defaultMaxBackjumps, ) import Distribution.Simple.InstallDirs @@ -191,6 +191,7 @@ resolveSolverSettings ProjectConfig{ (getMapMappend projectConfigSpecificPackage) solverSettingCabalVersion = flagToMaybe projectConfigCabalVersion solverSettingSolver = fromFlag projectConfigSolver + solverSettingAllowOlder = fromJust projectConfigAllowOlder solverSettingAllowNewer = fromJust projectConfigAllowNewer solverSettingMaxBackjumps = case fromFlag projectConfigMaxBackjumps of n | n < 0 -> Nothing @@ -209,6 +210,7 @@ resolveSolverSettings ProjectConfig{ defaults = mempty { projectConfigSolver = Flag defaultSolver, + projectConfigAllowOlder = Just (AllowOlder RelaxDepsNone), projectConfigAllowNewer = Just (AllowNewer RelaxDepsNone), projectConfigMaxBackjumps = Flag defaultMaxBackjumps, projectConfigReorderGoals = Flag (ReorderGoals False), diff --git a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs index 35b6bd3afd5..17998939768 100644 --- a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs @@ -40,7 +40,7 @@ import Distribution.Simple.Setup , ConfigFlags(..), configureOptions , HaddockFlags(..), haddockOptions, defaultHaddockFlags , programConfigurationPaths', splitArgs - , AllowNewer(..), RelaxDeps(..) ) + , AllowNewer(..), AllowOlder(..), RelaxDeps(..) ) import Distribution.Client.Setup ( GlobalFlags(..), globalCommand , ConfigExFlags(..), configureExOptions, defaultConfigExFlags @@ -285,6 +285,7 @@ convertLegacyAllPackageFlags globalFlags configFlags --configInstallDirs = projectConfigInstallDirs, --configUserInstall = projectConfigUserInstall, --configPackageDBs = projectConfigPackageDBs, + configAllowOlder = projectConfigAllowOlder, configAllowNewer = projectConfigAllowNewer } = configFlags @@ -476,6 +477,7 @@ convertToLegacySharedConfig configFlags = mempty { configVerbosity = projectConfigVerbosity, + configAllowOlder = projectConfigAllowOlder, configAllowNewer = projectConfigAllowNewer } @@ -574,6 +576,7 @@ convertToLegacyAllPackageConfig configFlagError = mempty, --TODO: ??? configRelocatable = mempty, configDebugInfo = mempty, + configAllowOlder = mempty, configAllowNewer = mempty } @@ -635,6 +638,7 @@ convertToLegacyPerPackageConfig PackageConfig {..} = configFlagError = mempty, --TODO: ??? configRelocatable = packageConfigRelocatable, configDebugInfo = packageConfigDebugInfo, + configAllowOlder = mempty, configAllowNewer = mempty } @@ -785,6 +789,12 @@ legacySharedConfigFieldDescrs = ( liftFields legacyConfigureShFlags (\flags conf -> conf { legacyConfigureShFlags = flags }) + . addFields + [ simpleField "allow-older" + (maybe mempty dispRelaxDeps) (fmap Just parseRelaxDeps) + (fmap unAllowOlder . configAllowOlder) + (\v conf -> conf { configAllowOlder = fmap AllowOlder v }) + ] . addFields [ simpleField "allow-newer" (maybe mempty dispRelaxDeps) (fmap Just parseRelaxDeps) diff --git a/cabal-install/Distribution/Client/ProjectConfig/Types.hs b/cabal-install/Distribution/Client/ProjectConfig/Types.hs index cea10815988..75cbbb2a93d 100644 --- a/cabal-install/Distribution/Client/ProjectConfig/Types.hs +++ b/cabal-install/Distribution/Client/ProjectConfig/Types.hs @@ -43,7 +43,7 @@ import Distribution.Simple.Compiler ( Compiler, CompilerFlavor , OptimisationLevel(..), ProfDetailLevel, DebugInfoLevel(..) ) import Distribution.Simple.Setup - ( Flag, AllowNewer(..) ) + ( Flag, AllowNewer(..), AllowOlder(..) ) import Distribution.Simple.InstallDirs ( PathTemplate ) import Distribution.Utils.NubList @@ -162,6 +162,7 @@ data ProjectConfigShared projectConfigPreferences :: [Dependency], projectConfigCabalVersion :: Flag Version, --TODO: [required eventually] unused projectConfigSolver :: Flag PreSolver, + projectConfigAllowOlder :: Maybe AllowOlder, projectConfigAllowNewer :: Maybe AllowNewer, projectConfigMaxBackjumps :: Flag Int, projectConfigReorderGoals :: Flag ReorderGoals, @@ -317,6 +318,7 @@ data SolverSettings solverSettingFlagAssignments :: Map PackageName FlagAssignment, solverSettingCabalVersion :: Maybe Version, --TODO: [required eventually] unused solverSettingSolver :: PreSolver, + solverSettingAllowOlder :: AllowOlder, solverSettingAllowNewer :: AllowNewer, solverSettingMaxBackjumps :: Maybe Int, solverSettingReorderGoals :: ReorderGoals, diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 00e32025418..4a347a97721 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -886,7 +886,8 @@ planPackages comp platform solver SolverSettings{..} then PreferAllLatest else PreferLatestForSelected)-} - . removeUpperBounds (Cabal.unAllowNewer solverSettingAllowNewer) + . removeLowerBounds solverSettingAllowOlder + . removeUpperBounds solverSettingAllowNewer . addDefaultSetupDependencies (defaultSetupDeps comp platform . PD.packageDescription @@ -1978,6 +1979,7 @@ setupHsConfigureFlags (ReadyPackage configStripExes = toFlag pkgStripExes configStripLibs = toFlag pkgStripLibs configDebugInfo = toFlag pkgDebugInfo + configAllowOlder = mempty -- we use configExactConfiguration True configAllowNewer = mempty -- we use configExactConfiguration True configConfigurationsFlags = pkgFlagAssignment diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index 0d9b8579421..bef29eee045 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -369,8 +369,9 @@ filterConfigureFlags flags cabalLibVersion flags_latest = flags { -- Cabal >= 1.19.1 uses '--dependency' and does not need '--constraint'. configConstraints = [], - -- Passing '--allow-newer' to Setup.hs is unnecessary, we use + -- Passing '--allow-{older,newer}' to Setup.hs is unnecessary, we use -- '--exact-configuration' instead. + configAllowOlder = Just (Cabal.AllowOlder Cabal.RelaxDepsNone), configAllowNewer = Just (Cabal.AllowNewer Cabal.RelaxDepsNone) } diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs index a6fc925f2fa..6d125848d0f 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs @@ -344,7 +344,7 @@ instance Arbitrary ProjectConfigShared where <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary + <*> arbitrary <*> arbitrary where arbitraryConstraints :: Gen [(UserConstraint, ConstraintSource)] arbitraryConstraints = @@ -353,18 +353,19 @@ instance Arbitrary ProjectConfigShared where shrink (ProjectConfigShared x00 x01 x02 x03 x04 x05 x06 x07 x08 x09 - x10 x11 x12 x13 x14) = + x10 x11 x12 x13 x14 x15) = [ ProjectConfigShared x00' (fmap getNonEmpty x01') (fmap getNonEmpty x02') x03' x04' x05' (postShrink_Constraints x06') x07' x08' x09' - x10' x11' x12' x13' x14' + x10' x11' x12' x13' x14' x15' | ((x00', x01', x02', x03', x04'), (x05', x06', x07', x08', x09'), - (x10', x11', x12', x13', x14')) + (x10', x11', x12', x13', x14'), + x15') <- shrink ((x00, fmap NonEmpty x01, fmap NonEmpty x02, x03, x04), (x05, preShrink_Constraints x06, x07, x08, x09), - (x10, x11, x12, x13, x14)) + (x10, x11, x12, x13, x14), x15) ] where preShrink_Constraints = map fst