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
+               (fromMaybe AllowNewerNone $ configAllowOlder cfg) $
+               relaxPackageDeps removeUpperBound
                (fromMaybe AllowNewerNone $ configAllowNewer cfg)
                pkg_descr0'
 
@@ -861,14 +863,15 @@ dependencySatisfiable
                       $ PackageIndex.lookupDependency internalPackageSet d
 
 -- | Relax the dependencies of this package if needed.
-relaxPackageDeps :: AllowNewer -> GenericPackageDescription
-                 -> GenericPackageDescription
-relaxPackageDeps AllowNewerNone gpd = gpd
-relaxPackageDeps AllowNewerAll  gpd = transformAllBuildDepends relaxAll gpd
+relaxPackageDeps :: (VersionRange -> VersionRange)
+                 -> AllowNewer
+                 -> GenericPackageDescription -> GenericPackageDescription
+relaxPackageDeps _ AllowNewerNone gpd = gpd
+relaxPackageDeps vrtrans AllowNewerAll  gpd = transformAllBuildDepends relaxAll gpd
   where
     relaxAll = \(Dependency pkgName verRange) ->
-      Dependency pkgName (removeUpperBound verRange)
-relaxPackageDeps (AllowNewerSome allowNewerDeps') gpd =
+      Dependency pkgName (vrtrans verRange)
+relaxPackageDeps vrtrans (AllowNewerSome allowNewerDeps') gpd =
   transformAllBuildDepends relaxSome gpd
   where
     thisPkgName    = packageName gpd
@@ -880,7 +883,7 @@ relaxPackageDeps (AllowNewerSome allowNewerDeps') gpd =
 
     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

@@ -391,6 +391,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 AllowNewer, -- ^ dual to 'configAllowNewer'
     configAllowNewer :: Maybe AllowNewer
     -- ^ Ignore upper bounds on all or some dependencies. Wrapped in 'Maybe' to
     -- distinguish between "default" and "explicitly disabled".
@@ -688,6 +689,13 @@ configureOptions showOrParseArgs =
          configLibCoverage (\v flags -> flags { configLibCoverage = v })
          (boolOpt [] [])
 
+      ,option [] ["allow-older"]
+       ("Ignore lower bounds in all dependencies or DEPS")
+       configAllowOlder (\v flags -> flags { configAllowOlder = v})
+       (optArg "DEPS"
+        (readP_to_E ("Cannot parse the list of packages: " ++) allowNewerParser)
+        (Just AllowNewerAll) allowNewerPrinter)
+
       ,option [] ["allow-newer"]
        ("Ignore upper bounds in all dependencies or DEPS")
        configAllowNewer (\v flags -> flags { configAllowNewer = v})

Cabal/Distribution/Version.hs

@@ -70,6 +70,7 @@ module Distribution.Version (
 
   -- ** Modification
   removeUpperBound,
+  removeLowerBound,
 
   -- * Version intervals view
   asVersionIntervals,
@@ -288,6 +289,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

@@ -321,6 +321,8 @@ instance Semigroup SavedConfig where
         configExactConfiguration  = combine configExactConfiguration,
         configFlagError           = combine configFlagError,
         configRelocatable         = combine configRelocatable,
+        configAllowOlder          = combineMonoid savedConfigureFlags
+                                    configAllowOlder,
         configAllowNewer          = combineMonoid savedConfigureFlags
                                     configAllowNewer
         }
@@ -629,6 +631,7 @@ commentSavedConfig = do
     savedConfigureExFlags  = defaultConfigExFlags,
     savedConfigureFlags    = (defaultConfigFlags defaultProgramConfiguration) {
       configUserInstall    = toFlag defaultUserInstall,
+      configAllowOlder     = Just AllowNewerNone,
       configAllowNewer     = Just AllowNewerNone
     },
     savedUserInstallDirs   = fmap toFlag userInstallDirs,
@@ -658,6 +661,19 @@ configFieldDescriptions src =
        [simpleField "compiler"
           (fromFlagOrDefault Disp.empty . fmap Text.disp) (optional Text.parse)
           configHcFlavor (\v flags -> flags { configHcFlavor = v })
+        -- TODO: de-duplicate showAllowNewer/toAllowNewer/...
+       ,let showAllowNewer Nothing               = mempty
+            showAllowNewer (Just AllowNewerNone) = Disp.text "False"
+            showAllowNewer (Just _)              = Disp.text "True"
+
+            toAllowNewer True  = Just AllowNewerAll
+            toAllowNewer False = Just AllowNewerNone
+
+            pkgs = (Just . AllowNewerSome) `fmap` parseOptCommaList Text.parse
+            parseAllowNewer = (toAllowNewer `fmap` Text.parse) Parse.<++ pkgs in
+        simpleField "allow-older"
+        showAllowNewer parseAllowNewer
+        configAllowOlder (\v flags -> flags { configAllowOlder = v })
        ,let showAllowNewer Nothing               = mempty
             showAllowNewer (Just AllowNewerNone) = Disp.text "False"
             showAllowNewer (Just _)              = Disp.text "True"

cabal-install/Distribution/Client/Configure.hs

@@ -90,11 +90,13 @@ chooseCabalVersion configFlags maybeVersion =
   maybe defaultVersionRange thisVersion maybeVersion
   where
     -- Cabal < 1.19.2 doesn't support '--exact-configuration' which is needed
-    -- for '--allow-newer' to work.
+    -- for '--allow-{older,newer}' to work.
+    allowOlder = isAllowNewer
+                 (fromMaybe AllowNewerNone $ configAllowOlder configFlags)
     allowNewer = isAllowNewer
                  (fromMaybe AllowNewerNone $ configAllowNewer configFlags)
 
-    defaultVersionRange = if allowNewer
+    defaultVersionRange = if allowOlder || allowNewer
                           then orLaterVersion (Version [1,19,2] [])
                           else anyVersion
 
@@ -306,7 +308,9 @@ planLocalPackage verbosity comp platform configFlags configExFlags
         fromFlagOrDefault False $ configBenchmarks configFlags
 
       resolverParams =
-          removeUpperBounds
+          removeLowerBounds
+          (fromMaybe AllowNewerNone $ configAllowOlder configFlags)
+        . removeUpperBounds
           (fromMaybe AllowNewerNone $ configAllowNewer configFlags)
 
         . addPreferences

cabal-install/Distribution/Client/Dependency.hs

@@ -58,6 +58,7 @@ module Distribution.Client.Dependency (
     hideInstalledPackagesSpecificByUnitId,
     hideInstalledPackagesSpecificBySourcePackageId,
     hideInstalledPackagesAllVersions,
+    removeLowerBounds,
     removeUpperBounds,
     addDefaultSetupDependencies,
   ) where
@@ -93,7 +94,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
@@ -400,7 +402,23 @@ removeUpperBounds allowNewer     params =
 
     relaxDeps :: UnresolvedSourcePackage -> UnresolvedSourcePackage
     relaxDeps srcPkg = srcPkg {
-      packageDescription = relaxPackageDeps allowNewer
+      packageDescription = relaxPackageDeps removeUpperBound allowNewer
+                           (packageDescription srcPkg)
+      }
+
+-- | Dual of 'removeUpperBounds'
+removeLowerBounds :: AllowNewer -> DepResolverParams -> DepResolverParams
+removeLowerBounds AllowNewerNone params = params
+removeLowerBounds 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

@@ -388,6 +388,7 @@ planPackages comp platform mSandboxPkgInfo solver
       . setPreferenceDefault (if upgradeDeps then PreferAllLatest
                                              else PreferLatestForSelected)
 
+      . removeLowerBounds allowOlder
       . removeUpperBounds allowNewer
 
       . addPreferences
@@ -438,6 +439,7 @@ planPackages comp platform mSandboxPkgInfo solver
     maxBackjumps     = fromFlag (installMaxBackjumps      installFlags)
     upgradeDeps      = fromFlag (installUpgradeDeps       installFlags)
     onlyDeps         = fromFlag (installOnlyDeps          installFlags)
+    allowOlder       = fromMaybe AllowNewerNone (configAllowOlder configFlags)
     allowNewer       = fromMaybe AllowNewerNone (configAllowNewer configFlags)
 
 -- | Remove the provided targets from the install plan.

cabal-install/Distribution/Client/ProjectConfig.hs

@@ -190,6 +190,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
@@ -207,6 +208,7 @@ resolveSolverSettings ProjectConfig{
 
     defaults = mempty {
        projectConfigSolver            = Flag defaultSolver,
+       projectConfigAllowOlder        = Just AllowNewerNone,
        projectConfigAllowNewer        = Just AllowNewerNone,
        projectConfigMaxBackjumps      = Flag defaultMaxBackjumps,
        projectConfigReorderGoals      = Flag (ReorderGoals False),

cabal-install/Distribution/Client/ProjectConfig/Legacy.hs

@@ -285,6 +285,7 @@ convertLegacyAllPackageFlags globalFlags configFlags
     --configInstallDirs         = projectConfigInstallDirs,
     --configUserInstall         = projectConfigUserInstall,
     --configPackageDBs          = projectConfigPackageDBs,
+      configAllowOlder          = projectConfigAllowOlder,
       configAllowNewer          = projectConfigAllowNewer
     } = configFlags
 
@@ -474,6 +475,7 @@ convertToLegacySharedConfig
 
     configFlags = mempty {
       configVerbosity     = projectConfigVerbosity,
+      configAllowOlder    = projectConfigAllowOlder,
       configAllowNewer    = projectConfigAllowNewer
     }
 
@@ -570,6 +572,7 @@ convertToLegacyAllPackageConfig
       configFlagError           = mempty,                --TODO: ???
       configRelocatable         = mempty,
       configDebugInfo           = mempty,
+      configAllowOlder          = mempty,
       configAllowNewer          = mempty
     }
 
@@ -631,6 +634,7 @@ convertToLegacyPerPackageConfig PackageConfig {..} =
       configFlagError           = mempty,                --TODO: ???
       configRelocatable         = packageConfigRelocatable,
       configDebugInfo           = packageConfigDebugInfo,
+      configAllowOlder          = mempty,
       configAllowNewer          = mempty
     }
 
@@ -781,6 +785,11 @@ legacySharedConfigFieldDescrs =
   ( liftFields
       legacyConfigureShFlags
       (\flags conf -> conf { legacyConfigureShFlags = flags })
+  . addFields
+      [ simpleField "allow-older"
+        (maybe mempty dispAllowNewer) (fmap Just parseAllowNewer)
+        configAllowOlder (\v conf -> conf { configAllowOlder = v })
+      ]
   . addFields
       [ simpleField "allow-newer"
         (maybe mempty dispAllowNewer) (fmap Just parseAllowNewer)

cabal-install/Distribution/Client/ProjectConfig/Types.hs

@@ -161,6 +161,7 @@ data ProjectConfigShared
        projectConfigPreferences       :: [Dependency],
        projectConfigCabalVersion      :: Flag Version,  --TODO: [required eventually] unused
        projectConfigSolver            :: Flag PreSolver,
+       projectConfigAllowOlder        :: Maybe AllowNewer,
        projectConfigAllowNewer        :: Maybe AllowNewer,
        projectConfigMaxBackjumps      :: Flag Int,
        projectConfigReorderGoals      :: Flag ReorderGoals,
@@ -315,6 +316,7 @@ data SolverSettings
        solverSettingFlagAssignments   :: Map PackageName FlagAssignment,
        solverSettingCabalVersion      :: Maybe Version,  --TODO: [required eventually] unused
        solverSettingSolver            :: PreSolver,
+       solverSettingAllowOlder        :: AllowNewer,
        solverSettingAllowNewer        :: AllowNewer,
        solverSettingMaxBackjumps      :: Maybe Int,
        solverSettingReorderGoals      :: ReorderGoals,

cabal-install/Distribution/Client/ProjectPlanning.hs

@@ -863,6 +863,7 @@ planPackages comp platform solver SolverSettings{..}
                                 then PreferAllLatest
                                 else PreferLatestForSelected)-}
 
+      . removeLowerBounds solverSettingAllowOlder
       . removeUpperBounds solverSettingAllowNewer
 
       . addDefaultSetupDependencies (defaultSetupDeps comp platform
@@ -1958,6 +1959,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

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.AllowNewerNone,
       configAllowNewer  = Just Cabal.AllowNewerNone
       }