From a95b8f4e06163675cb827bf63496b08140a9e0c6 Mon Sep 17 00:00:00 2001 From: Herbert Valerio Riedel Date: Fri, 19 May 2017 00:50:25 +0200 Subject: [PATCH 1/4] Remove --allow-{newer,older} support from Cabal This is a preparatory refactoring needed for future work such as #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 #4203. Closes #3581 --- Cabal/Distribution/Simple/Configure.hs | 38 +----- Cabal/Distribution/Simple/Setup.hs | 113 +----------------- cabal-install/Distribution/Client/Config.hs | 46 +++---- .../Distribution/Client/Configure.hs | 24 ++-- .../Distribution/Client/Dependency.hs | 36 +++++- cabal-install/Distribution/Client/Install.hs | 8 +- .../Distribution/Client/ProjectConfig.hs | 7 +- .../Client/ProjectConfig/Legacy.hs | 55 ++++----- .../Client/ProjectConfig/Types.hs | 4 +- .../Distribution/Client/ProjectPlanning.hs | 2 - cabal-install/Distribution/Client/Setup.hs | 42 +++++-- cabal-install/Distribution/Client/Types.hs | 83 +++++++++++++ 12 files changed, 226 insertions(+), 232 deletions(-) diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index 1cd3ed244b5..d92e8e7ce24 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/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. diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index 456a6f14b43..2d0eed6d720 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/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 diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs index e94dff25478..283442e4fac 100644 --- a/cabal-install/Distribution/Client/Config.hs +++ b/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) diff --git a/cabal-install/Distribution/Client/Configure.hs b/cabal-install/Distribution/Client/Configure.hs index 609de3efd7f..196c1ac2bd6 100644 --- a/cabal-install/Distribution/Client/Configure.hs +++ b/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 diff --git a/cabal-install/Distribution/Client/Dependency.hs b/cabal-install/Distribution/Client/Dependency.hs index a92a72b1730..d7b939ea05a 100644 --- a/cabal-install/Distribution/Client/Dependency.hs +++ b/cabal-install/Distribution/Client/Dependency.hs @@ -71,7 +71,9 @@ import Distribution.Client.SolverInstallPlan (SolverInstallPlan) import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan import Distribution.Client.Types ( SourcePackageDb(SourcePackageDb) - , UnresolvedPkgLoc, UnresolvedSourcePackage ) + , UnresolvedPkgLoc, UnresolvedSourcePackage + , AllowNewer(..), AllowOlder(..), RelaxDeps(..), RelaxedDep(..) + ) import Distribution.Client.Dependency.Types ( PreSolver(..), Solver(..) , PackagesPreferenceDefault(..) ) @@ -100,10 +102,8 @@ import Distribution.Client.Utils ( duplicates, duplicatesBy, mergeBy, MergeResult(..) ) import Distribution.Simple.Utils ( comparing ) -import Distribution.Simple.Configure - ( relaxPackageDeps ) import Distribution.Simple.Setup - ( asBool, AllowNewer(..), AllowOlder(..), RelaxDeps(..) ) + ( asBool ) import Distribution.Text ( display ) import Distribution.Verbosity @@ -133,7 +133,7 @@ import Distribution.Solver.Types.Variable import Data.List ( foldl', sort, sortBy, nubBy, maximumBy, intercalate, nub ) import Data.Function (on) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Map as Map import qualified Data.Set as Set import Data.Set (Set) @@ -456,6 +456,32 @@ removeLowerBounds (AllowOlder allowNewer) params = (packageDescription srcPkg) } +-- | Relax the dependencies of this package if needed. +-- +-- Helper function used by 'removeLowerBound' and 'removeUpperBounds' +relaxPackageDeps :: (VersionRange -> VersionRange) + -> RelaxDeps + -> PD.GenericPackageDescription -> PD.GenericPackageDescription +relaxPackageDeps _ RelaxDepsNone gpd = gpd +relaxPackageDeps vrtrans RelaxDepsAll gpd = PD.transformAllBuildDepends relaxAll gpd + where + relaxAll = \(Dependency pkgName verRange) -> + Dependency pkgName (vrtrans verRange) +relaxPackageDeps vrtrans (RelaxDepsSome allowNewerDeps') gpd = + PD.transformAllBuildDepends relaxSome gpd + where + thisPkgName = packageName gpd + allowNewerDeps = mapMaybe f allowNewerDeps' + + f (RelaxedDep p) = Just p + f (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 + -- | Supply defaults for packages without explicit Setup dependencies -- -- Note: It's important to apply 'addDefaultSetupDepends' after diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index 26062674145..2bbbef825a7 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -125,7 +125,6 @@ import Distribution.Simple.PackageIndex (InstalledPackageIndex) import Distribution.Simple.Setup ( haddockCommand, HaddockFlags(..) , buildCommand, BuildFlags(..), emptyBuildFlags - , AllowNewer(..), AllowOlder(..), RelaxDeps(..) , toFlag, fromFlag, fromFlagOrDefault, flagToMaybe, defaultDistPref ) import qualified Distribution.Simple.Setup as Cabal ( Flag(..) @@ -458,10 +457,11 @@ planPackages verbosity comp platform mSandboxPkgInfo solver allowBootLibInstalls = fromFlag (installAllowBootLibInstalls installFlags) upgradeDeps = fromFlag (installUpgradeDeps installFlags) onlyDeps = fromFlag (installOnlyDeps installFlags) + allowOlder = fromMaybe (AllowOlder RelaxDepsNone) - (configAllowOlder configFlags) + (configAllowOlder configExFlags) allowNewer = fromMaybe (AllowNewer RelaxDepsNone) - (configAllowNewer configFlags) + (configAllowNewer configExFlags) -- | Remove the provided targets from the install plan. pruneInstallPlan :: Package targetpkg @@ -1117,7 +1117,7 @@ performInstallations verbosity platform progdb distPref - (chooseCabalVersion configFlags (libVersion miscOptions)) + (chooseCabalVersion configExFlags (libVersion miscOptions)) (Just lock) parallelInstall index diff --git a/cabal-install/Distribution/Client/ProjectConfig.hs b/cabal-install/Distribution/Client/ProjectConfig.hs index a5a92b29e07..f4d4ef42c86 100644 --- a/cabal-install/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/Distribution/Client/ProjectConfig.hs @@ -90,7 +90,7 @@ import Distribution.Simple.Program ( ConfiguredProgram(..) ) import Distribution.Simple.Setup ( Flag(Flag), toFlag, flagToMaybe, flagToList - , fromFlag, fromFlagOrDefault, AllowNewer(..), AllowOlder(..), RelaxDeps(..) ) + , fromFlag, fromFlagOrDefault ) import Distribution.Client.Setup ( defaultSolver, defaultMaxBackjumps ) import Distribution.Simple.InstallDirs @@ -111,7 +111,6 @@ import Distribution.ParseUtils import Control.Monad import Control.Monad.Trans (liftIO) import Control.Exception -import Data.Maybe import Data.Either import qualified Data.Map as Map import Data.Set (Set) @@ -201,8 +200,8 @@ resolveSolverSettings ProjectConfig{ (getMapMappend projectConfigSpecificPackage) solverSettingCabalVersion = flagToMaybe projectConfigCabalVersion solverSettingSolver = fromFlag projectConfigSolver - solverSettingAllowOlder = fromJust projectConfigAllowOlder - solverSettingAllowNewer = fromJust projectConfigAllowNewer + solverSettingAllowOlder = fromMaybe mempty projectConfigAllowOlder + solverSettingAllowNewer = fromMaybe mempty projectConfigAllowNewer solverSettingMaxBackjumps = case fromFlag projectConfigMaxBackjumps of n | n < 0 -> Nothing | otherwise -> Just n diff --git a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs index d9465852a27..becc63e91f6 100644 --- a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs @@ -25,7 +25,9 @@ import Distribution.Client.Compat.Prelude import Distribution.Client.ProjectConfig.Types import Distribution.Client.Types - ( RemoteRepo(..), emptyRemoteRepo ) + ( RemoteRepo(..), emptyRemoteRepo + , AllowNewer(..), AllowOlder(..), RelaxDeps(..) ) + import Distribution.Client.Config ( SavedConfig(..), remoteRepoFields ) @@ -33,7 +35,7 @@ import Distribution.Solver.Types.ConstraintSource import Distribution.Package import Distribution.PackageDescription - ( SourceRepo(..), RepoKind(..) + ( SourceRepo(..), RepoKind(..) , dispFlagAssignment, parseFlagAssignment ) import Distribution.PackageDescription.Parse ( sourceRepoFieldDescrs ) @@ -44,7 +46,7 @@ import Distribution.Simple.Setup , ConfigFlags(..), configureOptions , HaddockFlags(..), haddockOptions, defaultHaddockFlags , programDbPaths', splitArgs - , AllowNewer(..), AllowOlder(..), RelaxDeps(..) ) + ) import Distribution.Client.Setup ( GlobalFlags(..), globalCommand , ConfigExFlags(..), configureExOptions, defaultConfigExFlags @@ -278,19 +280,19 @@ convertLegacyAllPackageFlags globalFlags configFlags configDistPref = projectConfigDistDir, configHcFlavor = projectConfigHcFlavor, configHcPath = projectConfigHcPath, - configHcPkg = projectConfigHcPkg, + configHcPkg = projectConfigHcPkg --configInstallDirs = projectConfigInstallDirs, --configUserInstall = projectConfigUserInstall, --configPackageDBs = projectConfigPackageDBs, - configAllowOlder = projectConfigAllowOlder, - configAllowNewer = projectConfigAllowNewer } = configFlags ConfigExFlags { configCabalVersion = projectConfigCabalVersion, configExConstraints = projectConfigConstraints, configPreferences = projectConfigPreferences, - configSolver = projectConfigSolver + configSolver = projectConfigSolver, + configAllowOlder = projectConfigAllowOlder, + configAllowNewer = projectConfigAllowNewer } = configExFlags InstallFlags { @@ -481,16 +483,17 @@ convertToLegacySharedConfig configFlags = mempty { configVerbosity = projectConfigVerbosity, - configDistPref = projectConfigDistDir, - configAllowOlder = projectConfigAllowOlder, - configAllowNewer = projectConfigAllowNewer + configDistPref = projectConfigDistDir } configExFlags = ConfigExFlags { configCabalVersion = projectConfigCabalVersion, configExConstraints = projectConfigConstraints, configPreferences = projectConfigPreferences, - configSolver = projectConfigSolver + configSolver = projectConfigSolver, + configAllowOlder = projectConfigAllowOlder, + configAllowNewer = projectConfigAllowNewer + } installFlags = InstallFlags { @@ -589,9 +592,7 @@ convertToLegacyAllPackageConfig configBenchmarks = mempty, configFlagError = mempty, --TODO: ??? configRelocatable = mempty, - configDebugInfo = mempty, - configAllowOlder = mempty, - configAllowNewer = mempty + configDebugInfo = mempty } haddockFlags = mempty { @@ -656,9 +657,7 @@ convertToLegacyPerPackageConfig PackageConfig {..} = configBenchmarks = packageConfigBenchmarks, configFlagError = mempty, --TODO: ??? configRelocatable = packageConfigRelocatable, - configDebugInfo = packageConfigDebugInfo, - configAllowOlder = mempty, - configAllowNewer = mempty + configDebugInfo = packageConfigDebugInfo } installFlags = mempty { @@ -809,18 +808,6 @@ 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) - (fmap unAllowNewer . configAllowNewer) - (\v conf -> conf { configAllowNewer = fmap AllowNewer v }) - ] . filterFields ["verbose", "builddir" ] . commandOptionsToFields ) (configureOptions ParseArgs) @@ -836,6 +823,16 @@ legacySharedConfigFieldDescrs = , commaNewLineListField "preferences" disp parse configPreferences (\v conf -> conf { configPreferences = v }) + + , simpleField "allow-older" + (maybe mempty dispRelaxDeps) (fmap Just parseRelaxDeps) + (fmap unAllowOlder . configAllowOlder) + (\v conf -> conf { configAllowOlder = fmap AllowOlder v }) + + , simpleField "allow-newer" + (maybe mempty dispRelaxDeps) (fmap Just parseRelaxDeps) + (fmap unAllowNewer . configAllowNewer) + (\v conf -> conf { configAllowNewer = fmap AllowNewer v }) ] . filterFields [ "cabal-lib-version", "solver" diff --git a/cabal-install/Distribution/Client/ProjectConfig/Types.hs b/cabal-install/Distribution/Client/ProjectConfig/Types.hs index 45dc78049bf..6dd6be5d23d 100644 --- a/cabal-install/Distribution/Client/ProjectConfig/Types.hs +++ b/cabal-install/Distribution/Client/ProjectConfig/Types.hs @@ -21,7 +21,7 @@ module Distribution.Client.ProjectConfig.Types ( ) where import Distribution.Client.Types - ( RemoteRepo ) + ( RemoteRepo, AllowNewer(..), AllowOlder(..) ) import Distribution.Client.Dependency.Types ( PreSolver ) import Distribution.Client.Targets @@ -48,7 +48,7 @@ import Distribution.Simple.Compiler ( Compiler, CompilerFlavor , OptimisationLevel(..), ProfDetailLevel, DebugInfoLevel(..) ) import Distribution.Simple.Setup - ( Flag, AllowNewer(..), AllowOlder(..), HaddockTarget(..) ) + ( Flag, HaddockTarget(..) ) import Distribution.Simple.InstallDirs ( PathTemplate ) import Distribution.Utils.NubList diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index d7d299ce7af..dc375ef1635 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -3025,8 +3025,6 @@ setupHsConfigureFlags (ReadyPackage elab@ElaboratedConfiguredPackage{..}) configStripExes = toFlag elabStripExes configStripLibs = toFlag elabStripLibs configDebugInfo = toFlag elabDebugInfo - configAllowOlder = mempty -- we use configExactConfiguration True - configAllowNewer = mempty -- we use configExactConfiguration True configConfigurationsFlags = elabFlagAssignment configConfigureArgs = elabConfigureScriptArgs diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index 0347ebf04c1..dc8551b951c 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -60,7 +60,9 @@ import Prelude () import Distribution.Client.Compat.Prelude hiding (get) import Distribution.Client.Types - ( Username(..), Password(..), RemoteRepo(..) ) + ( Username(..), Password(..), RemoteRepo(..) + , AllowNewer(..), AllowOlder(..), RelaxDeps(..) + ) import Distribution.Client.BuildReports.Types ( ReportLevel(..) ) import Distribution.Client.Dependency.Types @@ -414,11 +416,7 @@ filterConfigureFlags flags cabalLibVersion where flags_latest = flags { -- Cabal >= 1.19.1 uses '--dependency' and does not need '--constraint'. - configConstraints = [], - -- 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) + configConstraints = [] } flags_1_25_0 = flags_latest { @@ -506,7 +504,9 @@ data ConfigExFlags = ConfigExFlags { configCabalVersion :: Flag Version, configExConstraints:: [(UserConstraint, ConstraintSource)], configPreferences :: [Dependency], - configSolver :: Flag PreSolver + configSolver :: Flag PreSolver, + configAllowNewer :: Maybe AllowNewer, + configAllowOlder :: Maybe AllowOlder } deriving (Eq, Generic) @@ -555,8 +555,36 @@ configureExOptions _showOrParseArgs src = , optionSolver configSolver (\v flags -> flags { configSolver = v }) + , 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) + ] + +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 + + instance Monoid ConfigExFlags where mempty = gmempty mappend = (<>) diff --git a/cabal-install/Distribution/Client/Types.hs b/cabal-install/Distribution/Client/Types.hs index ed54c0f9c7c..f38f466858e 100644 --- a/cabal-install/Distribution/Client/Types.hs +++ b/cabal-install/Distribution/Client/Types.hs @@ -52,7 +52,10 @@ import Distribution.Solver.Types.OptionalStanza import Distribution.Solver.Types.PackageFixedDeps import Distribution.Solver.Types.SourcePackage import Distribution.Compat.Graph (IsNode(..)) +import qualified Distribution.Compat.ReadP as Parse +import Distribution.Compat.Semigroup import Distribution.Simple.Utils (ordNub) +import Distribution.Text (Text(..)) import Data.Map (Map) import Network.URI (URI(..), URIAuth(..), nullURI) @@ -61,6 +64,7 @@ import Control.Exception import Data.Typeable (Typeable) import GHC.Generics (Generic) import Distribution.Compat.Binary (Binary(..)) +import qualified Text.PrettyPrint as Disp newtype Username = Username { unUsername :: String } @@ -370,3 +374,82 @@ instance Binary TestsResult instance Binary SomeException where put _ = return () get = fail "cannot serialise exceptions" + + +-- ------------------------------------------------------------ +-- * --allow-newer/--allow-older +-- ------------------------------------------------------------ + +-- TODO: When https://github.com/haskell/cabal/issues/4203 gets tackled, +-- it may make sense to move these definitions to the Solver.Types +-- module + +-- | '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) + +-- | 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 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) + +-- | 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 = (<>) From 13c208421a7c86494e8e4da1035d428241f61bc6 Mon Sep 17 00:00:00 2001 From: Herbert Valerio Riedel Date: Fri, 19 May 2017 14:06:58 +0200 Subject: [PATCH 2/4] Add changelog note about feature removal (#4527) --- Cabal/changelog | 1 + 1 file changed, 1 insertion(+) diff --git a/Cabal/changelog b/Cabal/changelog index 5912765f8b7..71a7cbceec9 100644 --- a/Cabal/changelog +++ b/Cabal/changelog @@ -1,6 +1,7 @@ -*-change-log-*- 2.2.0.0 (current development version) + * Remove unused '--allow-newer'/'--allow-older' support (#4527) * TODO 2.0.0.0 Ryan Thomas May 2017 From dbf9d6ccd536a241a8b59b2b1123425408fcca7a Mon Sep 17 00:00:00 2001 From: Herbert Valerio Riedel Date: Fri, 19 May 2017 14:06:24 +0200 Subject: [PATCH 3/4] Update testsuite to account for #4527 --- .../PackageTests/AllowNewer/setup.cabal.out | 111 ------------------ .../PackageTests/AllowNewer/setup.out | 46 -------- .../PackageTests/AllowNewer/setup.test.hs | 25 ---- .../PackageTests/AllowOlder/Setup.hs | 3 + .../PackageTests/AllowOlder/cabal.project | 1 + .../PackageTests/AllowOlder/cabal.test.hs | 28 +++++ .../PackageTests/AllowOlder/setup.cabal.out | 111 ------------------ .../PackageTests/AllowOlder/setup.out | 46 -------- .../PackageTests/AllowOlder/setup.test.hs | 24 ---- 9 files changed, 32 insertions(+), 363 deletions(-) delete mode 100644 cabal-testsuite/PackageTests/AllowNewer/setup.cabal.out delete mode 100644 cabal-testsuite/PackageTests/AllowNewer/setup.out delete mode 100644 cabal-testsuite/PackageTests/AllowNewer/setup.test.hs create mode 100644 cabal-testsuite/PackageTests/AllowOlder/Setup.hs create mode 100644 cabal-testsuite/PackageTests/AllowOlder/cabal.project create mode 100644 cabal-testsuite/PackageTests/AllowOlder/cabal.test.hs delete mode 100644 cabal-testsuite/PackageTests/AllowOlder/setup.cabal.out delete mode 100644 cabal-testsuite/PackageTests/AllowOlder/setup.out delete mode 100644 cabal-testsuite/PackageTests/AllowOlder/setup.test.hs diff --git a/cabal-testsuite/PackageTests/AllowNewer/setup.cabal.out b/cabal-testsuite/PackageTests/AllowNewer/setup.cabal.out deleted file mode 100644 index b4c33af02aa..00000000000 --- a/cabal-testsuite/PackageTests/AllowNewer/setup.cabal.out +++ /dev/null @@ -1,111 +0,0 @@ -# Setup configure -Resolving dependencies... -Warning: solver failed to find a solution: -Could not resolve dependencies: -trying: AllowNewer-0.1.0.0 (user goal) -next goal: base (dependency of AllowNewer-0.1.0.0) -rejecting: base-/installed-... (conflict: AllowNewer => base<1) -fail (backjumping, conflict set: AllowNewer, base) -After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: AllowNewer (3), base (2)Trying configure anyway. -Configuring AllowNewer-0.1.0.0... -cabal: Encountered missing dependencies: - base ==0.* -# Setup configure -Resolving dependencies... -Configuring AllowNewer-0.1.0.0... -# Setup configure -Resolving dependencies... -Warning: solver failed to find a solution: -Could not resolve dependencies: -trying: AllowNewer-0.1.0.0 (user goal) -next goal: base (dependency of AllowNewer-0.1.0.0) -rejecting: base-/installed-... (conflict: AllowNewer => base<1) -fail (backjumping, conflict set: AllowNewer, base) -After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: AllowNewer (3), base (2)Trying configure anyway. -Configuring AllowNewer-0.1.0.0... -cabal: Encountered missing dependencies: - base ==0.* -# Setup configure -Resolving dependencies... -Configuring AllowNewer-0.1.0.0... -# Setup configure -Resolving dependencies... -Configuring AllowNewer-0.1.0.0... -# Setup configure -Resolving dependencies... -Warning: solver failed to find a solution: -Could not resolve dependencies: -trying: AllowNewer-0.1.0.0 (user goal) -next goal: base (dependency of AllowNewer-0.1.0.0) -rejecting: base-/installed-... (conflict: AllowNewer => base<1) -fail (backjumping, conflict set: AllowNewer, base) -After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: AllowNewer (3), base (2)Trying configure anyway. -Configuring AllowNewer-0.1.0.0... -cabal: Encountered missing dependencies: - base ==0.* -# Setup configure -Resolving dependencies... -Configuring AllowNewer-0.1.0.0... -# Setup configure -Resolving dependencies... -Warning: solver failed to find a solution: -Could not resolve dependencies: -trying: AllowNewer-0.1.0.0 (user goal) -next goal: base (dependency of AllowNewer-0.1.0.0) -rejecting: base-/installed-... (conflict: AllowNewer => base<1) -fail (backjumping, conflict set: AllowNewer, base) -After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: AllowNewer (3), base (2)Trying configure anyway. -Configuring AllowNewer-0.1.0.0... -cabal: Encountered missing dependencies: - base ==0.* -# Setup configure -Resolving dependencies... -Configuring AllowNewer-0.1.0.0... -# Setup configure -Resolving dependencies... -Warning: solver failed to find a solution: -Could not resolve dependencies: -trying: AllowNewer-0.1.0.0 (user goal) -next goal: base (dependency of AllowNewer-0.1.0.0) -rejecting: base-/installed-... (conflict: AllowNewer => base<1) -fail (backjumping, conflict set: AllowNewer, base) -After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: AllowNewer (3), base (2)Trying configure anyway. -Configuring AllowNewer-0.1.0.0... -cabal: Encountered missing dependencies: - base ==0.* -# Setup configure -Resolving dependencies... -Configuring AllowNewer-0.1.0.0... -# Setup configure -Resolving dependencies... -Warning: solver failed to find a solution: -Could not resolve dependencies: -trying: AllowNewer-0.1.0.0 (user goal) -next goal: base (dependency of AllowNewer-0.1.0.0) -rejecting: base-/installed-... (conflict: AllowNewer => base<1) -fail (backjumping, conflict set: AllowNewer, base) -After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: AllowNewer (3), base (2)Trying configure anyway. -Configuring AllowNewer-0.1.0.0... -cabal: Encountered missing dependencies: - base ==0.* -# Setup configure -Resolving dependencies... -Warning: solver failed to find a solution: -Could not resolve dependencies: -trying: AllowNewer-0.1.0.0 (user goal) -next goal: base (dependency of AllowNewer-0.1.0.0) -rejecting: base-/installed-... (conflict: AllowNewer => base<1) -fail (backjumping, conflict set: AllowNewer, base) -After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: AllowNewer (3), base (2)Trying configure anyway. -Configuring AllowNewer-0.1.0.0... -cabal: Encountered missing dependencies: - base ==0.* -# Setup configure -Resolving dependencies... -Configuring AllowNewer-0.1.0.0... -# Setup configure -Resolving dependencies... -Configuring AllowNewer-0.1.0.0... -# Setup configure -Resolving dependencies... -Configuring AllowNewer-0.1.0.0... diff --git a/cabal-testsuite/PackageTests/AllowNewer/setup.out b/cabal-testsuite/PackageTests/AllowNewer/setup.out deleted file mode 100644 index fa1b37e007d..00000000000 --- a/cabal-testsuite/PackageTests/AllowNewer/setup.out +++ /dev/null @@ -1,46 +0,0 @@ -# Setup configure -Configuring AllowNewer-0.1.0.0... -setup: Encountered missing dependencies: - base ==0.* -# Setup configure -Configuring AllowNewer-0.1.0.0... -# Setup configure -Configuring AllowNewer-0.1.0.0... -setup: Encountered missing dependencies: - base ==0.* -# Setup configure -Configuring AllowNewer-0.1.0.0... -# Setup configure -Configuring AllowNewer-0.1.0.0... -# Setup configure -Configuring AllowNewer-0.1.0.0... -setup: Encountered missing dependencies: - base ==0.* -# Setup configure -Configuring AllowNewer-0.1.0.0... -# Setup configure -Configuring AllowNewer-0.1.0.0... -setup: Encountered missing dependencies: - base ==0.* -# Setup configure -Configuring AllowNewer-0.1.0.0... -# Setup configure -Configuring AllowNewer-0.1.0.0... -setup: Encountered missing dependencies: - base ==0.* -# Setup configure -Configuring AllowNewer-0.1.0.0... -# Setup configure -Configuring AllowNewer-0.1.0.0... -setup: Encountered missing dependencies: - base ==0.* -# Setup configure -Configuring AllowNewer-0.1.0.0... -setup: Encountered missing dependencies: - base ==0.* -# Setup configure -Configuring AllowNewer-0.1.0.0... -# Setup configure -Configuring AllowNewer-0.1.0.0... -# Setup configure -Configuring AllowNewer-0.1.0.0... diff --git a/cabal-testsuite/PackageTests/AllowNewer/setup.test.hs b/cabal-testsuite/PackageTests/AllowNewer/setup.test.hs deleted file mode 100644 index 12a650d8890..00000000000 --- a/cabal-testsuite/PackageTests/AllowNewer/setup.test.hs +++ /dev/null @@ -1,25 +0,0 @@ -import Test.Cabal.Prelude --- Test Setup.hs understand --allow-newer -main = setupAndCabalTest $ do - fails $ setup "configure" [] - setup "configure" ["--allow-newer"] - fails $ setup "configure" ["--allow-newer=baz,quux"] - setup "configure" ["--allow-newer=base", "--allow-newer=baz,quux"] - setup "configure" ["--allow-newer=bar", "--allow-newer=base,baz" - ,"--allow-newer=quux"] - fails $ setup "configure" ["--enable-tests"] - setup "configure" ["--enable-tests", "--allow-newer"] - fails $ setup "configure" ["--enable-benchmarks"] - setup "configure" ["--enable-benchmarks", "--allow-newer"] - fails $ setup "configure" ["--enable-benchmarks", "--enable-tests"] - setup "configure" ["--enable-benchmarks", "--enable-tests" - ,"--allow-newer"] - fails $ setup "configure" ["--allow-newer=Foo:base"] - fails $ setup "configure" ["--allow-newer=Foo:base" - ,"--enable-tests", "--enable-benchmarks"] - setup "configure" ["--allow-newer=AllowNewer:base"] - setup "configure" ["--allow-newer=AllowNewer:base" - ,"--allow-newer=Foo:base"] - setup "configure" ["--allow-newer=AllowNewer:base" - ,"--allow-newer=Foo:base" - ,"--enable-tests", "--enable-benchmarks"] diff --git a/cabal-testsuite/PackageTests/AllowOlder/Setup.hs b/cabal-testsuite/PackageTests/AllowOlder/Setup.hs new file mode 100644 index 00000000000..b55cb169539 --- /dev/null +++ b/cabal-testsuite/PackageTests/AllowOlder/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple +main :: IO () +main = defaultMain diff --git a/cabal-testsuite/PackageTests/AllowOlder/cabal.project b/cabal-testsuite/PackageTests/AllowOlder/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-testsuite/PackageTests/AllowOlder/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-testsuite/PackageTests/AllowOlder/cabal.test.hs b/cabal-testsuite/PackageTests/AllowOlder/cabal.test.hs new file mode 100644 index 00000000000..34df5bb31d5 --- /dev/null +++ b/cabal-testsuite/PackageTests/AllowOlder/cabal.test.hs @@ -0,0 +1,28 @@ +import Test.Cabal.Prelude hiding (cabal) +import qualified Test.Cabal.Prelude as P +-- See #4332, dep solving output is not deterministic +main = cabalTest . recordMode DoNotRecord $ do + fails $ cabal "new-build" [] + cabal "new-build" ["--allow-older"] + fails $ cabal "new-build" ["--allow-older=baz,quux"] + cabal "new-build" ["--allow-older=base", "--allow-older=baz,quux"] + cabal "new-build" ["--allow-older=bar", "--allow-older=base,baz" + ,"--allow-older=quux"] + fails $ cabal "new-build" ["--enable-tests"] + cabal "new-build" ["--enable-tests", "--allow-older"] + fails $ cabal "new-build" ["--enable-benchmarks"] + cabal "new-build" ["--enable-benchmarks", "--allow-older"] + fails $ cabal "new-build" ["--enable-benchmarks", "--enable-tests"] + cabal "new-build" ["--enable-benchmarks", "--enable-tests" + ,"--allow-older"] + fails $ cabal "new-build" ["--allow-older=Foo:base"] + fails $ cabal "new-build" ["--allow-older=Foo:base" + ,"--enable-tests", "--enable-benchmarks"] + cabal "new-build" ["--allow-older=AllowOlder:base"] + cabal "new-build" ["--allow-older=AllowOlder:base" + ,"--allow-older=Foo:base"] + cabal "new-build" ["--allow-older=AllowOlder:base" + ,"--allow-older=Foo:base" + ,"--enable-tests", "--enable-benchmarks"] + where + cabal cmd args = P.cabal cmd ("--dry-run" : args) diff --git a/cabal-testsuite/PackageTests/AllowOlder/setup.cabal.out b/cabal-testsuite/PackageTests/AllowOlder/setup.cabal.out deleted file mode 100644 index fb8d4f53cbb..00000000000 --- a/cabal-testsuite/PackageTests/AllowOlder/setup.cabal.out +++ /dev/null @@ -1,111 +0,0 @@ -# Setup configure -Resolving dependencies... -Warning: solver failed to find a solution: -Could not resolve dependencies: -trying: AllowOlder-0.1.0.0 (user goal) -next goal: base (dependency of AllowOlder-0.1.0.0) -rejecting: base-/installed-... (conflict: AllowOlder => base>42) -fail (backjumping, conflict set: AllowOlder, base) -After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: AllowOlder (3), base (2)Trying configure anyway. -Configuring AllowOlder-0.1.0.0... -cabal: Encountered missing dependencies: - base >42 -# Setup configure -Resolving dependencies... -Configuring AllowOlder-0.1.0.0... -# Setup configure -Resolving dependencies... -Warning: solver failed to find a solution: -Could not resolve dependencies: -trying: AllowOlder-0.1.0.0 (user goal) -next goal: base (dependency of AllowOlder-0.1.0.0) -rejecting: base-/installed-... (conflict: AllowOlder => base>42) -fail (backjumping, conflict set: AllowOlder, base) -After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: AllowOlder (3), base (2)Trying configure anyway. -Configuring AllowOlder-0.1.0.0... -cabal: Encountered missing dependencies: - base >42 -# Setup configure -Resolving dependencies... -Configuring AllowOlder-0.1.0.0... -# Setup configure -Resolving dependencies... -Configuring AllowOlder-0.1.0.0... -# Setup configure -Resolving dependencies... -Warning: solver failed to find a solution: -Could not resolve dependencies: -trying: AllowOlder-0.1.0.0 (user goal) -next goal: base (dependency of AllowOlder-0.1.0.0) -rejecting: base-/installed-... (conflict: AllowOlder => base>42) -fail (backjumping, conflict set: AllowOlder, base) -After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: AllowOlder (3), base (2)Trying configure anyway. -Configuring AllowOlder-0.1.0.0... -cabal: Encountered missing dependencies: - base >42 -# Setup configure -Resolving dependencies... -Configuring AllowOlder-0.1.0.0... -# Setup configure -Resolving dependencies... -Warning: solver failed to find a solution: -Could not resolve dependencies: -trying: AllowOlder-0.1.0.0 (user goal) -next goal: base (dependency of AllowOlder-0.1.0.0) -rejecting: base-/installed-... (conflict: AllowOlder => base>42) -fail (backjumping, conflict set: AllowOlder, base) -After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: AllowOlder (3), base (2)Trying configure anyway. -Configuring AllowOlder-0.1.0.0... -cabal: Encountered missing dependencies: - base >42 -# Setup configure -Resolving dependencies... -Configuring AllowOlder-0.1.0.0... -# Setup configure -Resolving dependencies... -Warning: solver failed to find a solution: -Could not resolve dependencies: -trying: AllowOlder-0.1.0.0 (user goal) -next goal: base (dependency of AllowOlder-0.1.0.0) -rejecting: base-/installed-... (conflict: AllowOlder => base>42) -fail (backjumping, conflict set: AllowOlder, base) -After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: AllowOlder (3), base (2)Trying configure anyway. -Configuring AllowOlder-0.1.0.0... -cabal: Encountered missing dependencies: - base >42 -# Setup configure -Resolving dependencies... -Configuring AllowOlder-0.1.0.0... -# Setup configure -Resolving dependencies... -Warning: solver failed to find a solution: -Could not resolve dependencies: -trying: AllowOlder-0.1.0.0 (user goal) -next goal: base (dependency of AllowOlder-0.1.0.0) -rejecting: base-/installed-... (conflict: AllowOlder => base>42) -fail (backjumping, conflict set: AllowOlder, base) -After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: AllowOlder (3), base (2)Trying configure anyway. -Configuring AllowOlder-0.1.0.0... -cabal: Encountered missing dependencies: - base >42 -# Setup configure -Resolving dependencies... -Warning: solver failed to find a solution: -Could not resolve dependencies: -trying: AllowOlder-0.1.0.0 (user goal) -next goal: base (dependency of AllowOlder-0.1.0.0) -rejecting: base-/installed-... (conflict: AllowOlder => base>42) -fail (backjumping, conflict set: AllowOlder, base) -After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: AllowOlder (3), base (2)Trying configure anyway. -Configuring AllowOlder-0.1.0.0... -cabal: Encountered missing dependencies: - base >42 -# Setup configure -Resolving dependencies... -Configuring AllowOlder-0.1.0.0... -# Setup configure -Resolving dependencies... -Configuring AllowOlder-0.1.0.0... -# Setup configure -Resolving dependencies... -Configuring AllowOlder-0.1.0.0... diff --git a/cabal-testsuite/PackageTests/AllowOlder/setup.out b/cabal-testsuite/PackageTests/AllowOlder/setup.out deleted file mode 100644 index 89e3e7f7710..00000000000 --- a/cabal-testsuite/PackageTests/AllowOlder/setup.out +++ /dev/null @@ -1,46 +0,0 @@ -# Setup configure -Configuring AllowOlder-0.1.0.0... -setup: Encountered missing dependencies: - base >42 -# Setup configure -Configuring AllowOlder-0.1.0.0... -# Setup configure -Configuring AllowOlder-0.1.0.0... -setup: Encountered missing dependencies: - base >42 -# Setup configure -Configuring AllowOlder-0.1.0.0... -# Setup configure -Configuring AllowOlder-0.1.0.0... -# Setup configure -Configuring AllowOlder-0.1.0.0... -setup: Encountered missing dependencies: - base >42 -# Setup configure -Configuring AllowOlder-0.1.0.0... -# Setup configure -Configuring AllowOlder-0.1.0.0... -setup: Encountered missing dependencies: - base >42 -# Setup configure -Configuring AllowOlder-0.1.0.0... -# Setup configure -Configuring AllowOlder-0.1.0.0... -setup: Encountered missing dependencies: - base >42 -# Setup configure -Configuring AllowOlder-0.1.0.0... -# Setup configure -Configuring AllowOlder-0.1.0.0... -setup: Encountered missing dependencies: - base >42 -# Setup configure -Configuring AllowOlder-0.1.0.0... -setup: Encountered missing dependencies: - base >42 -# Setup configure -Configuring AllowOlder-0.1.0.0... -# Setup configure -Configuring AllowOlder-0.1.0.0... -# Setup configure -Configuring AllowOlder-0.1.0.0... diff --git a/cabal-testsuite/PackageTests/AllowOlder/setup.test.hs b/cabal-testsuite/PackageTests/AllowOlder/setup.test.hs deleted file mode 100644 index 49f390f3001..00000000000 --- a/cabal-testsuite/PackageTests/AllowOlder/setup.test.hs +++ /dev/null @@ -1,24 +0,0 @@ -import Test.Cabal.Prelude -main = setupAndCabalTest $ do - fails $ setup "configure" [] - setup "configure" ["--allow-older"] - fails $ setup "configure" ["--allow-older=baz,quux"] - setup "configure" ["--allow-older=base", "--allow-older=baz,quux"] - setup "configure" ["--allow-older=bar", "--allow-older=base,baz" - ,"--allow-older=quux"] - fails $ setup "configure" ["--enable-tests"] - setup "configure" ["--enable-tests", "--allow-older"] - fails $ setup "configure" ["--enable-benchmarks"] - setup "configure" ["--enable-benchmarks", "--allow-older"] - fails $ setup "configure" ["--enable-benchmarks", "--enable-tests"] - setup "configure" ["--enable-benchmarks", "--enable-tests" - ,"--allow-older"] - fails $ setup "configure" ["--allow-older=Foo:base"] - fails $ setup "configure" ["--allow-older=Foo:base" - ,"--enable-tests", "--enable-benchmarks"] - setup "configure" ["--allow-older=AllowOlder:base"] - setup "configure" ["--allow-older=AllowOlder:base" - ,"--allow-older=Foo:base"] - setup "configure" ["--allow-older=AllowOlder:base" - ,"--allow-older=Foo:base" - ,"--enable-tests", "--enable-benchmarks"] From c038b525b09d098557c20bc96d0ef41c908251a8 Mon Sep 17 00:00:00 2001 From: Herbert Valerio Riedel Date: Fri, 19 May 2017 14:10:49 +0200 Subject: [PATCH 4/4] restore compat with pre-AMP --- cabal-install/Distribution/Client/Types.hs | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/cabal-install/Distribution/Client/Types.hs b/cabal-install/Distribution/Client/Types.hs index f38f466858e..98af97b032a 100644 --- a/cabal-install/Distribution/Client/Types.hs +++ b/cabal-install/Distribution/Client/Types.hs @@ -20,6 +20,9 @@ ----------------------------------------------------------------------------- module Distribution.Client.Types where +import Prelude () +import Distribution.Client.Compat.Prelude + import Distribution.Package ( Package(..), HasMungedPackageId(..), HasUnitId(..) , PackageInstalled(..), newSimpleUnitId ) @@ -53,17 +56,12 @@ import Distribution.Solver.Types.PackageFixedDeps import Distribution.Solver.Types.SourcePackage import Distribution.Compat.Graph (IsNode(..)) import qualified Distribution.Compat.ReadP as Parse -import Distribution.Compat.Semigroup import Distribution.Simple.Utils (ordNub) import Distribution.Text (Text(..)) -import Data.Map (Map) import Network.URI (URI(..), URIAuth(..), nullURI) import Control.Exception ( Exception, SomeException ) -import Data.Typeable (Typeable) -import GHC.Generics (Generic) -import Distribution.Compat.Binary (Binary(..)) import qualified Text.PrettyPrint as Disp