Implement --allow-older

This provides the dual flag to `--allow-newer` for symmetry

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'
 
@@ -861,26 +863,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

@@ -71,6 +71,7 @@ module Distribution.Version (
 
   -- ** Modification
   removeUpperBound,
+  removeLowerBound,
 
   -- * Version intervals view
   asVersionIntervals,
@@ -299,6 +300,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-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
@@ -95,7 +96,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
@@ -107,7 +109,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)
       }
 

cabal-install/Distribution/Client/Install.hs

@@ -130,7 +130,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(..)
@@ -390,6 +390,7 @@ planPackages comp platform mSandboxPkgInfo solver
       . setPreferenceDefault (if upgradeDeps then PreferAllLatest
                                              else PreferLatestForSelected)
 
+      . removeLowerBounds allowOlder
       . removeUpperBounds allowNewer
 
       . addPreferences
@@ -441,7 +442,9 @@ 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

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

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)