Remove --allow-{newer,older} support from Cabal

This is a preparatory refactoring needed for future work such as haskell#4203.

I've refrained from doing additional cleanups in order to keep this a
refactoring that mostly moves around blocks of code mostly
unchanged (except for whitespace), and make it easier to review.

This feature was originally implemented because its lack was complained
about by Stack/Stackage developers. However, after it got implemented it
was never really being used; what's more, it's causing us overhead for
no benefit as well as blocking us improving the implementation via the
likes of haskell#4203.

Closes haskell#3581

Cabal/Distribution/Simple/Configure.hs

@@ -53,7 +53,6 @@ module Distribution.Simple.Configure (configure,
                                       ConfigStateFileError(..),
                                       tryGetConfigStateFile,
                                       platformDefines,
-                                      relaxPackageDeps,
                                      )
     where
 
@@ -330,18 +329,7 @@ findDistPrefOrDefault = findDistPref defaultDistPref
 -- Returns the @.setup-config@ file.
 configure :: (GenericPackageDescription, HookedBuildInfo)
           -> ConfigFlags -> IO LocalBuildInfo
-configure (pkg_descr0', pbi) cfg = do
-    let pkg_descr0 =
-          -- Ignore '--allow-{older,newer}' when we're given
-          -- '--exact-configuration'.
-          if fromFlagOrDefault False (configExactConfiguration cfg)
-          then pkg_descr0'
-          else relaxPackageDeps removeLowerBound
-               (maybe RelaxDepsNone unAllowOlder $ configAllowOlder cfg) $
-               relaxPackageDeps removeUpperBound
-               (maybe RelaxDepsNone unAllowNewer $ configAllowNewer cfg)
-               pkg_descr0'
-
+configure (pkg_descr0, pbi) cfg = do
     -- Determine the component we are configuring, if a user specified
     -- one on the command line.  We use a fake, flattened version of
     -- the package since at this point, we're not really sure what
@@ -890,30 +878,6 @@ dependencySatisfiable
            -- name
            = Just (mkUnqualComponentName (unPackageName depName))
 
--- | Relax the dependencies of this package if needed.
-relaxPackageDeps :: (VersionRange -> VersionRange)
-                 -> RelaxDeps
-                 -> GenericPackageDescription -> GenericPackageDescription
-relaxPackageDeps _ RelaxDepsNone gpd = gpd
-relaxPackageDeps vrtrans RelaxDepsAll  gpd = transformAllBuildDepends relaxAll gpd
-  where
-    relaxAll = \(Dependency pkgName verRange) ->
-      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
-
-    relaxSome = \d@(Dependency depName verRange) ->
-      if depName `elem` allowNewerDeps
-      then Dependency depName (vrtrans verRange)
-      else d
-
 -- | Finalize a generic package description.  The workhorse is
 -- 'finalizePD' but there's a bit of other nattering
 -- about necessary.

Cabal/Distribution/Simple/Setup.hs

@@ -37,8 +37,6 @@ module Distribution.Simple.Setup (
   GlobalFlags(..),   emptyGlobalFlags,   defaultGlobalFlags,   globalCommand,
   ConfigFlags(..),   emptyConfigFlags,   defaultConfigFlags,   configureCommand,
   configPrograms,
-  RelaxDeps(..),    RelaxedDep(..),  isRelaxDeps,
-  AllowNewer(..),   AllowOlder(..),
   configAbsolutePaths, readPackageDbList, showPackageDbList,
   CopyFlags(..),     emptyCopyFlags,     defaultCopyFlags,     copyCommand,
   InstallFlags(..),  emptyInstallFlags,  defaultInstallFlags,  installCommand,
@@ -273,92 +271,6 @@ instance Semigroup GlobalFlags where
 -- * Config flags
 -- ------------------------------------------------------------
 
--- | Generic data type for policy when relaxing bounds in dependencies.
--- Don't use this directly: use 'AllowOlder' or 'AllowNewer' depending
--- on whether or not you are relaxing an lower or upper bound
--- (respectively).
-data RelaxDeps =
-
-  -- | Default: honor the upper bounds in all dependencies, never choose
-  -- versions newer than allowed.
-  RelaxDepsNone
-
-  -- | Ignore upper bounds in dependencies on the given packages.
-  | RelaxDepsSome [RelaxedDep]
-
-  -- | Ignore upper bounds in dependencies on all packages.
-  | RelaxDepsAll
-  deriving (Eq, Read, Show, Generic)
-
--- | 'RelaxDeps' in the context of upper bounds (i.e. for @--allow-newer@ flag)
-newtype AllowNewer = AllowNewer { unAllowNewer :: RelaxDeps }
-                   deriving (Eq, Read, Show, Generic)
-
--- | 'RelaxDeps' in the context of lower bounds (i.e. for @--allow-older@ flag)
-newtype AllowOlder = AllowOlder { unAllowOlder :: RelaxDeps }
-                   deriving (Eq, Read, Show, Generic)
-
--- | Dependencies can be relaxed either for all packages in the install plan, or
--- only for some packages.
-data RelaxedDep = RelaxedDep PackageName
-                | RelaxedDepScoped PackageName PackageName
-                deriving (Eq, Read, Show, Generic)
-
-instance Text RelaxedDep where
-  disp (RelaxedDep p0)          = disp p0
-  disp (RelaxedDepScoped p0 p1) = disp p0 Disp.<> Disp.colon Disp.<> disp p1
-
-  parse = scopedP Parse.<++ normalP
-    where
-      scopedP = RelaxedDepScoped `fmap` parse <* Parse.char ':' <*> parse
-      normalP = RelaxedDep       `fmap` parse
-
-instance Binary RelaxDeps
-instance Binary RelaxedDep
-instance Binary AllowNewer
-instance Binary AllowOlder
-
-instance Semigroup RelaxDeps where
-  RelaxDepsNone       <> r                   = r
-  l@RelaxDepsAll      <> _                   = l
-  l@(RelaxDepsSome _) <> RelaxDepsNone       = l
-  (RelaxDepsSome   _) <> r@RelaxDepsAll      = r
-  (RelaxDepsSome   a) <> (RelaxDepsSome b)   = RelaxDepsSome (a ++ b)
-
-instance Monoid RelaxDeps where
-  mempty  = RelaxDepsNone
-  mappend = (<>)
-
-instance Semigroup AllowNewer where
-  AllowNewer x <> AllowNewer y = AllowNewer (x <> y)
-
-instance Semigroup AllowOlder where
-  AllowOlder x <> AllowOlder y = AllowOlder (x <> y)
-
-instance Monoid AllowNewer where
-  mempty  = AllowNewer mempty
-  mappend = (<>)
-
-instance Monoid AllowOlder where
-  mempty  = AllowOlder mempty
-  mappend = (<>)
-
--- | Convert 'RelaxDeps' to a boolean.
-isRelaxDeps :: RelaxDeps -> Bool
-isRelaxDeps RelaxDepsNone     = False
-isRelaxDeps (RelaxDepsSome _) = True
-isRelaxDeps RelaxDepsAll      = True
-
-relaxDepsParser :: Parse.ReadP r (Maybe RelaxDeps)
-relaxDepsParser =
-  (Just . RelaxDepsSome) `fmap` Parse.sepBy1 parse (Parse.char ',')
-
-relaxDepsPrinter :: (Maybe RelaxDeps) -> [Maybe String]
-relaxDepsPrinter Nothing                     = []
-relaxDepsPrinter (Just RelaxDepsNone)        = []
-relaxDepsPrinter (Just RelaxDepsAll)         = [Nothing]
-relaxDepsPrinter (Just (RelaxDepsSome pkgs)) = map (Just . display) $ pkgs
-
 -- | Flags to @configure@ command.
 --
 -- IMPORTANT: every time a new flag is added, 'D.C.Setup.filterConfigureFlags'
@@ -442,11 +354,7 @@ data ConfigFlags = ConfigFlags {
     configFlagError :: Flag String,
       -- ^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".
+    configDebugInfo :: Flag DebugInfoLevel  -- ^ Emit debug info.
   }
   deriving (Generic, Read, Show)
 
@@ -548,8 +456,7 @@ defaultConfigFlags progDb = emptyConfigFlags {
     configExactConfiguration = Flag False,
     configFlagError    = NoFlag,
     configRelocatable  = Flag False,
-    configDebugInfo    = Flag NoDebugInfo,
-    configAllowNewer   = Nothing
+    configDebugInfo    = Flag NoDebugInfo
   }
 
 configureCommand :: ProgramDb -> CommandUI ConfigFlags
@@ -826,22 +733,6 @@ 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)
-       (\v flags -> flags { configAllowNewer = fmap AllowNewer v})
-       (optArg "DEPS"
-        (readP_to_E ("Cannot parse the list of packages: " ++) relaxDepsParser)
-        (Just RelaxDepsAll) relaxDepsPrinter)
-
       ,option "" ["exact-configuration"]
          "All direct dependencies and flags are provided on the command line."
          configExactConfiguration

cabal-install/Distribution/Client/Config.hs

@@ -45,7 +45,9 @@ module Distribution.Client.Config (
   ) where
 
 import Distribution.Client.Types
-         ( RemoteRepo(..), Username(..), Password(..), emptyRemoteRepo )
+         ( RemoteRepo(..), Username(..), Password(..), emptyRemoteRepo
+         , AllowOlder(..), AllowNewer(..), RelaxDeps(..)
+         )
 import Distribution.Client.BuildReports.Types
          ( ReportLevel(..) )
 import Distribution.Client.Setup
@@ -62,7 +64,6 @@ import Distribution.Simple.Compiler
          ( DebugInfoLevel(..), OptimisationLevel(..) )
 import Distribution.Simple.Setup
          ( ConfigFlags(..), configureOptions, defaultConfigFlags
-         , AllowNewer(..), AllowOlder(..), RelaxDeps(..)
          , HaddockFlags(..), haddockOptions, defaultHaddockFlags
          , installDirsOptions, optionDistPref
          , programDbPaths', programDbOptions
@@ -330,11 +331,7 @@ instance Semigroup SavedConfig where
         configLibCoverage         = combine configLibCoverage,
         configExactConfiguration  = combine configExactConfiguration,
         configFlagError           = combine configFlagError,
-        configRelocatable         = combine configRelocatable,
-        configAllowOlder          = combineMonoid savedConfigureFlags
-                                    configAllowOlder,
-        configAllowNewer          = combineMonoid savedConfigureFlags
-                                    configAllowNewer
+        configRelocatable         = combine configRelocatable
         }
         where
           combine        = combine'        savedConfigureFlags
@@ -347,7 +344,9 @@ instance Semigroup SavedConfig where
         configExConstraints = lastNonEmpty configExConstraints,
         -- TODO: NubListify
         configPreferences   = lastNonEmpty configPreferences,
-        configSolver        = combine configSolver
+        configSolver        = combine configSolver,
+        configAllowNewer    = combineMonoid savedConfigureExFlags configAllowNewer,
+        configAllowOlder    = combineMonoid savedConfigureExFlags configAllowOlder
         }
         where
           combine      = combine' savedConfigureExFlags
@@ -702,12 +701,13 @@ commentSavedConfig = do
             globalRemoteRepos = toNubList [defaultRemoteRepo]
             },
         savedInstallFlags      = defaultInstallFlags,
-        savedConfigureExFlags  = defaultConfigExFlags,
-        savedConfigureFlags    = (defaultConfigFlags defaultProgramDb) {
-            configUserInstall    = toFlag defaultUserInstall,
+        savedConfigureExFlags  = defaultConfigExFlags {
             configAllowNewer     = Just (AllowNewer RelaxDepsNone),
             configAllowOlder     = Just (AllowOlder RelaxDepsNone)
             },
+        savedConfigureFlags    = (defaultConfigFlags defaultProgramDb) {
+            configUserInstall    = toFlag defaultUserInstall
+            },
         savedUserInstallDirs   = fmap toFlag userInstallDirs,
         savedGlobalInstallDirs = fmap toFlag globalInstallDirs,
         savedUploadFlags       = commandDefaultFlags uploadCommand,
@@ -749,16 +749,7 @@ configFieldDescriptions src =
        [simpleField "compiler"
           (fromFlagOrDefault Disp.empty . fmap Text.disp) (optional Text.parse)
           configHcFlavor (\v flags -> flags { configHcFlavor = v })
-       ,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"
-        (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
         -- fails on that. Instead of a hand-written hackaged parser
@@ -815,7 +806,18 @@ configFieldDescriptions src =
 
   ++ toSavedConfig liftConfigExFlag
        (configureExOptions ParseArgs src)
-       [] []
+       []
+       [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"
+        (showRelaxDeps . fmap unAllowNewer) parseAllowNewer
+        configAllowNewer (\v flags -> flags { configAllowNewer = v })
+       ]
 
   ++ toSavedConfig liftInstallFlag
        (installOptions ParseArgs)

cabal-install/Distribution/Client/Configure.hs

@@ -56,8 +56,8 @@ import Distribution.Simple.Compiler
 import Distribution.Simple.Program (ProgramDb)
 import Distribution.Client.SavedFlags ( readCommandFlags, writeCommandFlags )
 import Distribution.Simple.Setup
-         ( ConfigFlags(..), AllowNewer(..), AllowOlder(..), RelaxDeps(..)
-         , fromFlag, toFlag, flagToMaybe, fromFlagOrDefault, isRelaxDeps )
+         ( ConfigFlags(..)
+         , fromFlag, toFlag, flagToMaybe, fromFlagOrDefault )
 import Distribution.Simple.PackageIndex
          ( InstalledPackageIndex, lookupPackageName )
 import Distribution.Package
@@ -90,21 +90,27 @@ import System.FilePath ( (</>) )
 
 -- | Choose the Cabal version such that the setup scripts compiled against this
 -- version will support the given command-line flags.
-chooseCabalVersion :: ConfigFlags -> Maybe Version -> VersionRange
-chooseCabalVersion configFlags maybeVersion =
+chooseCabalVersion :: ConfigExFlags -> Maybe Version -> VersionRange
+chooseCabalVersion configExFlags maybeVersion =
   maybe defaultVersionRange thisVersion maybeVersion
   where
     -- Cabal < 1.19.2 doesn't support '--exact-configuration' which is needed
     -- for '--allow-newer' to work.
     allowNewer = isRelaxDeps
-                 (maybe RelaxDepsNone unAllowNewer $ configAllowNewer configFlags)
+                 (maybe RelaxDepsNone unAllowNewer $ configAllowNewer configExFlags)
     allowOlder = isRelaxDeps
-                 (maybe RelaxDepsNone unAllowOlder $ configAllowOlder configFlags)
+                 (maybe RelaxDepsNone unAllowOlder $ configAllowOlder configExFlags)
 
     defaultVersionRange = if allowOlder || allowNewer
                           then orLaterVersion (mkVersion [1,19,2])
                           else anyVersion
 
+-- | Convert 'RelaxDeps' to a boolean.
+isRelaxDeps :: RelaxDeps -> Bool
+isRelaxDeps RelaxDepsNone     = False
+isRelaxDeps (RelaxDepsSome _) = True
+isRelaxDeps RelaxDepsAll      = True
+
 -- | Configure the package found in the local directory
 configure :: Verbosity
           -> PackageDBStack
@@ -169,7 +175,7 @@ configure verbosity packageDBs repoCtxt comp platform progdb
            (useDistPref defaultSetupScriptOptions)
            (configDistPref configFlags))
         (chooseCabalVersion
-           configFlags
+           configExFlags
            (flagToMaybe (configCabalVersion configExFlags)))
         Nothing
         False
@@ -319,9 +325,9 @@ planLocalPackage verbosity comp platform configFlags configExFlags
 
       resolverParams =
           removeLowerBounds
-          (fromMaybe (AllowOlder RelaxDepsNone) $ configAllowOlder configFlags)
+          (fromMaybe (AllowOlder RelaxDepsNone) $ configAllowOlder configExFlags)
         . removeUpperBounds
-          (fromMaybe (AllowNewer RelaxDepsNone) $ configAllowNewer configFlags)
+          (fromMaybe (AllowNewer RelaxDepsNone) $ configAllowNewer configExFlags)
 
         . addPreferences
             -- preferences from the config file or command line