Implement --allow-older (dual to --allow-newer) (re haskell#3466)

This implements the flag `--allow-older` which is the analogous to
`--allow-newer` acting on lower bounds.

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

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,26 +873,27 @@ 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
     allowNewerDeps = mapMaybe f allowNewerDeps'
 
     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

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)

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.

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).
 

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

Cabal/tests/PackageTests/AllowOlder/AllowOlder.cabal

@@ -0,0 +1,25 @@
+name:                AllowOlder
+version:             0.1.0.0
+license:             BSD3
+author:              Foo Bar
+maintainer:          [email protected]
+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

Cabal/tests/PackageTests/AllowOlder/benchmarks/Bench.hs

@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = return ()

Cabal/tests/PackageTests/AllowOlder/src/Foo.hs

@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = return ()

Cabal/tests/PackageTests/AllowOlder/tests/Test.hs

@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = return ()

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.

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]

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

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)
       }