From 2251d56fd6fa63b3593f54345b2d26670790962d Mon Sep 17 00:00:00 2001 From: Mikhail Glushenkov Date: Thu, 18 Feb 2016 20:56:26 +0100 Subject: [PATCH 1/7] Refactor the '--allow-newer' implementation. Split the 'onAllBuildDepends' function in three parts and move it to 'Distribution.PackageDescription.Configuration'. --- .../PackageDescription/Configuration.hs | 81 +++++++++++++++++++ .../Distribution/Client/Dependency.hs | 63 ++------------- 2 files changed, 88 insertions(+), 56 deletions(-) diff --git a/Cabal/Distribution/PackageDescription/Configuration.hs b/Cabal/Distribution/PackageDescription/Configuration.hs index 9dc78d51edb..9b98d29068d 100644 --- a/Cabal/Distribution/PackageDescription/Configuration.hs +++ b/Cabal/Distribution/PackageDescription/Configuration.hs @@ -28,6 +28,8 @@ module Distribution.PackageDescription.Configuration ( mapTreeData, mapTreeConds, mapTreeConstrs, + transformAllBuildInfos, + transformAllBuildDepends, ) where import Distribution.Package @@ -665,3 +667,82 @@ biFillInDefaults bi = if null (hsSourceDirs bi) then bi { hsSourceDirs = [currentDir] } else bi + +-- Walk a 'GenericPackageDescription' and apply @onBuildInfo@/@onSetupBuildInfo@ +-- to all nested 'BuildInfo'/'SetupBuildInfo' values. +transformAllBuildInfos :: (BuildInfo -> BuildInfo) + -> (SetupBuildInfo -> SetupBuildInfo) + -> GenericPackageDescription + -> GenericPackageDescription +transformAllBuildInfos onBuildInfo onSetupBuildInfo gpd = gpd' + where + onLibrary lib = lib { libBuildInfo = onBuildInfo $ libBuildInfo lib } + onExecutable exe = exe { buildInfo = onBuildInfo $ buildInfo exe } + onTestSuite tst = tst { testBuildInfo = onBuildInfo $ testBuildInfo tst } + onBenchmark bmk = bmk { benchmarkBuildInfo = + onBuildInfo $ benchmarkBuildInfo bmk } + + pd = packageDescription gpd + pd' = pd { + library = fmap onLibrary (library pd), + executables = map onExecutable (executables pd), + testSuites = map onTestSuite (testSuites pd), + benchmarks = map onBenchmark (benchmarks pd), + setupBuildInfo = fmap onSetupBuildInfo (setupBuildInfo pd) + } + + gpd' = transformAllCondTrees onLibrary onExecutable + onTestSuite onBenchmark id + $ gpd { packageDescription = pd' } + +-- | Walk a 'GenericPackageDescription' and apply @f@ to all nested +-- @build-depends@ fields. +transformAllBuildDepends :: (Dependency -> Dependency) + -> GenericPackageDescription + -> GenericPackageDescription +transformAllBuildDepends f gpd = gpd' + where + onBI bi = bi { targetBuildDepends = map f $ targetBuildDepends bi } + onSBI stp = stp { setupDepends = map f $ setupDepends stp } + onPD pd = pd { buildDepends = map f $ buildDepends pd } + + pd' = onPD $ packageDescription gpd + gpd' = transformAllCondTrees id id id id (map f) + . transformAllBuildInfos onBI onSBI + $ gpd { packageDescription = pd' } + +-- | Walk all 'CondTree's inside a 'GenericPackageDescription' and apply +-- appropriate transformations to all nodes. Helper function used by +-- 'transformAllBuildDepends' and 'transformAllBuildInfos'. +transformAllCondTrees :: (Library -> Library) + -> (Executable -> Executable) + -> (TestSuite -> TestSuite) + -> (Benchmark -> Benchmark) + -> ([Dependency] -> [Dependency]) + -> GenericPackageDescription -> GenericPackageDescription +transformAllCondTrees onLibrary onExecutable + onTestSuite onBenchmark onDepends gpd = gpd' + where + gpd' = gpd { + condLibrary = condLib', + condExecutables = condExes', + condTestSuites = condTests', + condBenchmarks = condBenchs' + } + + condLib = condLibrary gpd + condExes = condExecutables gpd + condTests = condTestSuites gpd + condBenchs = condBenchmarks gpd + + condLib' = fmap (onCondTree onLibrary) condLib + condExes' = map (mapSnd $ onCondTree onExecutable) condExes + condTests' = map (mapSnd $ onCondTree onTestSuite) condTests + condBenchs' = map (mapSnd $ onCondTree onBenchmark) condBenchs + + mapSnd :: (a -> b) -> (c,a) -> (c,b) + mapSnd = fmap + + onCondTree :: (a -> b) -> CondTree v [Dependency] a + -> CondTree v [Dependency] b + onCondTree g = mapCondTree g onDepends id diff --git a/cabal-install/Distribution/Client/Dependency.hs b/cabal-install/Distribution/Client/Dependency.hs index 33fecc53a4d..89799e0b840 100644 --- a/cabal-install/Distribution/Client/Dependency.hs +++ b/cabal-install/Distribution/Client/Dependency.hs @@ -92,13 +92,11 @@ import Distribution.Package , Package(..), packageName, packageVersion , UnitId, Dependency(Dependency)) import qualified Distribution.PackageDescription as PD - ( PackageDescription(..), Library(..), Executable(..) - , TestSuite(..), Benchmark(..), SetupBuildInfo(..) - , GenericPackageDescription(..), CondTree + ( PackageDescription(..), SetupBuildInfo(..) + , GenericPackageDescription(..) , Flag(flagName), FlagName(..) ) -import Distribution.PackageDescription (BuildInfo(targetBuildDepends)) import Distribution.PackageDescription.Configuration - ( mapCondTree, finalizePackageDescription ) + ( finalizePackageDescription, transformAllBuildDepends ) import Distribution.Client.PackageUtils ( externalBuildDepends ) import Distribution.Version @@ -388,59 +386,12 @@ removeUpperBounds allowNewer params = (removeUpperBound verRange) | otherwise = d - -- Walk a 'GenericPackageDescription' and apply 'f' to all 'build-depends' - -- fields. onAllBuildDepends :: (Dependency -> Dependency) -> SourcePackage -> SourcePackage - onAllBuildDepends f srcPkg = srcPkg' - where - gpd = packageDescription srcPkg - pd = PD.packageDescription gpd - condLib = PD.condLibrary gpd - condExes = PD.condExecutables gpd - condTests = PD.condTestSuites gpd - condBenchs = PD.condBenchmarks gpd - - f' = onBuildInfo f - onBuildInfo g bi = bi - { targetBuildDepends = map g (targetBuildDepends bi) } - - onLibrary lib = lib { PD.libBuildInfo = f' $ PD.libBuildInfo lib } - onExecutable exe = exe { PD.buildInfo = f' $ PD.buildInfo exe } - onTestSuite tst = tst { PD.testBuildInfo = f' $ PD.testBuildInfo tst } - onBenchmark bmk = bmk { PD.benchmarkBuildInfo = - f' $ PD.benchmarkBuildInfo bmk } - onSetup stp = stp { PD.setupDepends = - map f $ PD.setupDepends stp } - - srcPkg' = srcPkg { packageDescription = gpd' } - gpd' = gpd { - PD.packageDescription = pd', - PD.condLibrary = condLib', - PD.condExecutables = condExes', - PD.condTestSuites = condTests', - PD.condBenchmarks = condBenchs' - } - pd' = pd { - PD.buildDepends = map f (PD.buildDepends pd), - PD.library = fmap onLibrary (PD.library pd), - PD.executables = map onExecutable (PD.executables pd), - PD.testSuites = map onTestSuite (PD.testSuites pd), - PD.benchmarks = map onBenchmark (PD.benchmarks pd), - PD.setupBuildInfo = fmap onSetup (PD.setupBuildInfo pd) - } - condLib' = fmap (onCondTree onLibrary) condLib - condExes' = map (mapSnd $ onCondTree onExecutable) condExes - condTests' = map (mapSnd $ onCondTree onTestSuite) condTests - condBenchs' = map (mapSnd $ onCondTree onBenchmark) condBenchs - - mapSnd :: (a -> b) -> (c,a) -> (c,b) - mapSnd = fmap - - onCondTree :: (a -> b) -> PD.CondTree v [Dependency] a - -> PD.CondTree v [Dependency] b - onCondTree g = mapCondTree g (map f) id - + onAllBuildDepends f srcPkg = srcPkg { + packageDescription = transformAllBuildDepends f + (packageDescription srcPkg) + } -- | Supply defaults for packages without explicit Setup dependencies -- From ac0397727a53a5df1d6c0065d33b2fc8c3773c13 Mon Sep 17 00:00:00 2001 From: Mikhail Glushenkov Date: Thu, 18 Feb 2016 22:26:02 +0100 Subject: [PATCH 2/7] Move 'configAllowNewer' to 'ConfigFlags'. --- Cabal/Distribution/Simple/Setup.hs | 82 +++++++++++++++++-- cabal-install/Distribution/Client/Config.hs | 6 +- .../Distribution/Client/Configure.hs | 14 ++-- .../Distribution/Client/Dependency.hs | 4 +- .../Distribution/Client/Dependency/Types.hs | 26 ------ cabal-install/Distribution/Client/Install.hs | 4 +- cabal-install/Distribution/Client/Setup.hs | 65 ++++----------- 7 files changed, 110 insertions(+), 91 deletions(-) diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index 707e3c44184..b5bf4c9fd35 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/Cabal/Distribution/Simple/Setup.hs @@ -34,6 +34,7 @@ module Distribution.Simple.Setup ( GlobalFlags(..), emptyGlobalFlags, defaultGlobalFlags, globalCommand, ConfigFlags(..), emptyConfigFlags, defaultConfigFlags, configureCommand, + AllowNewer(..), isAllowNewer, configAbsolutePaths, readPackageDbList, showPackageDbList, CopyFlags(..), emptyCopyFlags, defaultCopyFlags, copyCommand, InstallFlags(..), emptyInstallFlags, defaultInstallFlags, installCommand, @@ -64,7 +65,8 @@ module Distribution.Simple.Setup ( fromFlagOrDefault, flagToMaybe, flagToList, - boolOpt, boolOpt', trueArg, falseArg, optionVerbosity, optionNumJobs ) where + boolOpt, boolOpt', trueArg, falseArg, + optionVerbosity, optionNumJobs, readPToMaybe ) where import Distribution.Compiler import Distribution.ReadE @@ -86,6 +88,7 @@ import Distribution.Compat.Semigroup as Semi import Control.Monad (liftM) import Data.List ( sort ) +import Data.Maybe ( listToMaybe ) import Data.Char ( isSpace, isAlpha ) import GHC.Generics (Generic) @@ -252,6 +255,57 @@ instance Semigroup GlobalFlags where -- * Config flags -- ------------------------------------------------------------ +-- | Policy for relaxing upper bounds in dependencies. For example, given +-- 'build-depends: array >= 0.3 && < 0.5', are we allowed to relax the upper +-- bound and choose a version of 'array' that is greater or equal to 0.5? By +-- default the upper bounds are always strictly honored. +data AllowNewer = + + -- | Default: honor the upper bounds in all dependencies, never choose + -- versions newer than allowed. + AllowNewerNone + + -- | Ignore upper bounds in dependencies on the given packages. + | AllowNewerSome [PackageName] + + -- | Ignore upper bounds in dependencies on all packages. + | AllowNewerAll + deriving (Eq, Ord, Read, Show, Generic) + +instance Binary AllowNewer + +instance Semigroup AllowNewer where + AllowNewerNone <> r = r + l@AllowNewerAll <> _ = l + l@(AllowNewerSome _) <> AllowNewerNone = l + (AllowNewerSome _) <> r@AllowNewerAll = r + (AllowNewerSome a) <> (AllowNewerSome b) = AllowNewerSome (a ++ b) + +instance Monoid AllowNewer where + mempty = AllowNewerNone + mappend = (Semi.<>) + +-- | Convert 'AllowNewer' to a boolean. +isAllowNewer :: AllowNewer -> Bool +isAllowNewer AllowNewerNone = False +isAllowNewer (AllowNewerSome _) = True +isAllowNewer AllowNewerAll = True + +allowNewerParser :: ReadE AllowNewer +allowNewerParser = ReadE $ \s -> + case readPToMaybe pkgsParser s of + Just pkgs -> Right . AllowNewerSome $ pkgs + Nothing -> Left ("Cannot parse the list of packages: " ++ s) + where + pkgsParser = Parse.sepBy1 parse (Parse.char ',') + +allowNewerPrinter :: Flag AllowNewer -> [Maybe String] +allowNewerPrinter (Flag AllowNewerNone) = [Just "False"] +allowNewerPrinter (Flag AllowNewerAll) = [Just "True"] +allowNewerPrinter (Flag (AllowNewerSome pkgs)) = + [Just . intercalate "," . map display $ pkgs] +allowNewerPrinter NoFlag = [] + -- | Flags to @configure@ command. -- -- IMPORTANT: every time a new flag is added, 'D.C.Setup.filterConfigureFlags' @@ -319,7 +373,8 @@ 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. + configDebugInfo :: Flag DebugInfoLevel, -- ^ Emit debug info. + configAllowNewer :: Flag AllowNewer -- ^ } deriving (Generic, Read, Show) @@ -365,7 +420,8 @@ defaultConfigFlags progConf = emptyConfigFlags { configExactConfiguration = Flag False, configFlagError = NoFlag, configRelocatable = Flag False, - configDebugInfo = Flag NoDebugInfo + configDebugInfo = Flag NoDebugInfo, + configAllowNewer = NoFlag } configureCommand :: ProgramConfiguration -> CommandUI ConfigFlags @@ -602,6 +658,13 @@ configureOptions showOrParseArgs = configLibCoverage (\v flags -> flags { configLibCoverage = v }) (boolOpt [] []) + ,option [] ["allow-newer"] + ("Ignore upper bounds in all dependencies or DEPS") + configAllowNewer (\v flags -> flags { configAllowNewer = v}) + (optArg "DEPS" + (fmap Flag allowNewerParser) (Flag AllowNewerAll) + allowNewerPrinter) + ,option "" ["exact-configuration"] "All direct dependencies and flags are provided on the command line." configExactConfiguration @@ -769,7 +832,8 @@ instance Monoid ConfigFlags where configBenchmarks = mempty, configFlagError = mempty, configRelocatable = mempty, - configDebugInfo = mempty + configDebugInfo = mempty, + configAllowNewer = mempty } mappend = (Semi.<>) @@ -817,9 +881,13 @@ instance Semigroup ConfigFlags where configBenchmarks = combine configBenchmarks, configFlagError = combine configFlagError, configRelocatable = combine configRelocatable, - configDebugInfo = combine configDebugInfo + configDebugInfo = combine configDebugInfo, + configAllowNewer = combineAllowNewer (configAllowNewer a) + (configAllowNewer b) } where combine field = field a `mappend` field b + combineAllowNewer (Flag fa) (Flag fb) = (Flag $ fa `mappend` fb) + combineAllowNewer fa fb = fa `mappend` fb -- ------------------------------------------------------------ -- * Copy flags @@ -2156,6 +2224,10 @@ optionNumJobs get set = -- * Other Utils -- ------------------------------------------------------------ +readPToMaybe :: Parse.ReadP a a -> String -> Maybe a +readPToMaybe p str = listToMaybe [ r | (r,s) <- Parse.readP_to_S p str + , all isSpace s ] + -- | Arguments to pass to a @configure@ script, e.g. generated by -- @autoconf@. configureArgs :: Bool -> ConfigFlags -> [String] diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs index 5f21a36a025..784ca02157e 100644 --- a/cabal-install/Distribution/Client/Config.hs +++ b/cabal-install/Distribution/Client/Config.hs @@ -324,7 +324,8 @@ instance Semigroup SavedConfig where configLibCoverage = combine configLibCoverage, configExactConfiguration = combine configExactConfiguration, configFlagError = combine configFlagError, - configRelocatable = combine configRelocatable + configRelocatable = combine configRelocatable, + configAllowNewer = combine configAllowNewer } where combine = combine' savedConfigureFlags @@ -337,8 +338,7 @@ instance Semigroup SavedConfig where configExConstraints = lastNonEmpty configExConstraints, -- TODO: NubListify configPreferences = lastNonEmpty configPreferences, - configSolver = combine configSolver, - configAllowNewer = combine configAllowNewer + configSolver = combine configSolver } where combine = combine' savedConfigureExFlags diff --git a/cabal-install/Distribution/Client/Configure.hs b/cabal-install/Distribution/Client/Configure.hs index d84586ffb76..c0133b5b637 100644 --- a/cabal-install/Distribution/Client/Configure.hs +++ b/cabal-install/Distribution/Client/Configure.hs @@ -20,7 +20,7 @@ module Distribution.Client.Configure ( import Distribution.Client.Dependency import Distribution.Client.Dependency.Types - ( AllowNewer(..), isAllowNewer, ConstraintSource(..) + ( ConstraintSource(..) , LabeledPackageConstraint(..), showConstraintSource ) import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.InstallPlan (InstallPlan) @@ -62,6 +62,8 @@ import Distribution.Version ( anyVersion, thisVersion ) import Distribution.Simple.Utils as Utils ( warn, notice, info, debug, die ) +import Distribution.Simple.Setup + ( AllowNewer(..), isAllowNewer ) import Distribution.System ( Platform ) import Distribution.Text ( display ) @@ -78,14 +80,14 @@ import Data.Maybe (isJust, fromMaybe) -- | Choose the Cabal version such that the setup scripts compiled against this -- version will support the given command-line flags. -chooseCabalVersion :: ConfigExFlags -> Maybe Version -> VersionRange -chooseCabalVersion configExFlags maybeVersion = +chooseCabalVersion :: ConfigFlags -> Maybe Version -> VersionRange +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. allowNewer = fromFlagOrDefault False $ - fmap isAllowNewer (configAllowNewer configExFlags) + fmap isAllowNewer (configAllowNewer configFlags) defaultVersionRange = if allowNewer then orLaterVersion (Version [1,19,2] []) @@ -152,7 +154,7 @@ configure verbosity packageDBs repoCtxt comp platform conf (useDistPref defaultSetupScriptOptions) (configDistPref configFlags)) (chooseCabalVersion - configExFlags + configFlags (flagToMaybe (configCabalVersion configExFlags))) Nothing False @@ -288,7 +290,7 @@ planLocalPackage verbosity comp platform configFlags configExFlags resolverParams = removeUpperBounds (fromFlagOrDefault AllowNewerNone $ - configAllowNewer configExFlags) + configAllowNewer configFlags) . 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 89799e0b840..52ff4cbc729 100644 --- a/cabal-install/Distribution/Client/Dependency.hs +++ b/cabal-install/Distribution/Client/Dependency.hs @@ -78,7 +78,7 @@ import Distribution.Client.Dependency.Types , PackageConstraint(..), showPackageConstraint , LabeledPackageConstraint(..), unlabelPackageConstraint , ConstraintSource(..), showConstraintSource - , AllowNewer(..), PackagePreferences(..), InstalledPreference(..) + , PackagePreferences(..), InstalledPreference(..) , PackagesPreferenceDefault(..) , Progress(..), foldProgress ) import Distribution.Client.Sandbox.Types @@ -110,6 +110,8 @@ import Distribution.Client.Utils ( duplicates, duplicatesBy, mergeBy, MergeResult(..) ) import Distribution.Simple.Utils ( comparing, warn, info ) +import Distribution.Simple.Setup + ( AllowNewer(..) ) import Distribution.Text ( display ) import Distribution.Verbosity diff --git a/cabal-install/Distribution/Client/Dependency/Types.hs b/cabal-install/Distribution/Client/Dependency/Types.hs index 0631914aa73..66066c605d3 100644 --- a/cabal-install/Distribution/Client/Dependency/Types.hs +++ b/cabal-install/Distribution/Client/Dependency/Types.hs @@ -19,7 +19,6 @@ module Distribution.Client.Dependency.Types ( DependencyResolver, ResolverPackage(..), - AllowNewer(..), isAllowNewer, PackageConstraint(..), showPackageConstraint, PackagePreferences(..), @@ -211,31 +210,6 @@ data PackagesPreferenceDefault = | PreferLatestForSelected deriving Show --- | Policy for relaxing upper bounds in dependencies. For example, given --- 'build-depends: array >= 0.3 && < 0.5', are we allowed to relax the upper --- bound and choose a version of 'array' that is greater or equal to 0.5? By --- default the upper bounds are always strictly honored. -data AllowNewer = - - -- | Default: honor the upper bounds in all dependencies, never choose - -- versions newer than allowed. - AllowNewerNone - - -- | Ignore upper bounds in dependencies on the given packages. - | AllowNewerSome [PackageName] - - -- | Ignore upper bounds in dependencies on all packages. - | AllowNewerAll - deriving (Eq, Ord, Show, Generic) - -instance Binary AllowNewer - --- | Convert 'AllowNewer' to a boolean. -isAllowNewer :: AllowNewer -> Bool -isAllowNewer AllowNewerNone = False -isAllowNewer (AllowNewerSome _) = True -isAllowNewer AllowNewerAll = True - -- | A type to represent the unfolding of an expensive long running -- calculation that may fail. We may get intermediate steps before the final -- result which may be used to indicate progress and\/or logging messages. diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index 67e81b26df0..40eefd3d4b1 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -417,7 +417,7 @@ planPackages comp platform mSandboxPkgInfo solver maxBackjumps = fromFlag (installMaxBackjumps installFlags) upgradeDeps = fromFlag (installUpgradeDeps installFlags) onlyDeps = fromFlag (installOnlyDeps installFlags) - allowNewer = fromFlag (configAllowNewer configExFlags) + allowNewer = fromFlag (configAllowNewer configFlags) -- | Remove the provided targets from the install plan. pruneInstallPlan :: Package targetpkg @@ -1092,7 +1092,7 @@ performInstallations verbosity platform conf distPref - (chooseCabalVersion configExFlags (libVersion miscOptions)) + (chooseCabalVersion configFlags (libVersion miscOptions)) (Just lock) parallelInstall index diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index 2b9d29e85d3..7966ccba8b9 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -58,7 +58,7 @@ import Distribution.Client.Types import Distribution.Client.BuildReports.Types ( ReportLevel(..) ) import Distribution.Client.Dependency.Types - ( AllowNewer(..), PreSolver(..), ConstraintSource(..) ) + ( PreSolver(..), ConstraintSource(..) ) import qualified Distribution.Client.Init.Types as IT ( InitFlags(..), PackageType(..) ) import Distribution.Client.Targets @@ -79,7 +79,8 @@ import Distribution.Simple.Setup , SDistFlags(..), HaddockFlags(..) , readPackageDbList, showPackageDbList , Flag(..), toFlag, flagToMaybe, flagToList - , optionVerbosity, boolOpt, boolOpt', trueArg, falseArg, optionNumJobs ) + , optionVerbosity, boolOpt, boolOpt', trueArg, falseArg + , readPToMaybe, optionNumJobs ) import Distribution.Simple.InstallDirs ( PathTemplate, InstallDirs(sysconfdir) , toPathTemplate, fromPathTemplate ) @@ -94,7 +95,7 @@ import Distribution.Text import Distribution.ReadE ( ReadE(..), readP_to_E, succeedReadE ) import qualified Distribution.Compat.ReadP as Parse - ( ReadP, readP_to_S, readS_to_P, char, munch1, pfail, sepBy1, (+++) ) + ( ReadP, readS_to_P, char, munch1, pfail, (+++) ) import Distribution.Compat.Semigroup ( Semigroup((<>)) ) import Distribution.Verbosity @@ -107,11 +108,11 @@ import Distribution.Client.GlobalFlags ) import Data.Char - ( isSpace, isAlphaNum ) + ( isAlphaNum ) import Data.List ( intercalate, deleteFirstsBy ) import Data.Maybe - ( listToMaybe, maybeToList, fromMaybe ) + ( maybeToList, fromMaybe ) #if !MIN_VERSION_base(4,8,0) import Data.Monoid ( Monoid(..) ) @@ -364,8 +365,13 @@ filterConfigureFlags flags cabalLibVersion | cabalLibVersion < Version [1,23,0] [] = flags_1_22_0 | otherwise = flags_latest where - -- Cabal >= 1.19.1 uses '--dependency' and does not need '--constraint'. - flags_latest = flags { configConstraints = [] } + 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 + -- '--exact-configuration' instead. + configAllowNewer = NoFlag + } -- Cabal < 1.23 doesn't know about '--profiling-detail'. flags_1_22_0 = flags_latest { configProfDetail = NoFlag @@ -418,14 +424,12 @@ data ConfigExFlags = ConfigExFlags { configCabalVersion :: Flag Version, configExConstraints:: [(UserConstraint, ConstraintSource)], configPreferences :: [Dependency], - configSolver :: Flag PreSolver, - configAllowNewer :: Flag AllowNewer + configSolver :: Flag PreSolver } deriving (Eq, Generic) defaultConfigExFlags :: ConfigExFlags -defaultConfigExFlags = mempty { configSolver = Flag defaultSolver - , configAllowNewer = Flag AllowNewerNone } +defaultConfigExFlags = mempty { configSolver = Flag defaultSolver } configureExCommand :: CommandUI (ConfigFlags, ConfigExFlags) configureExCommand = configureCommand { @@ -469,23 +473,14 @@ configureExOptions _showOrParseArgs src = , optionSolver configSolver (\v flags -> flags { configSolver = v }) - , option [] ["allow-newer"] - ("Ignore upper bounds in all dependencies or " ++ allowNewerArgument) - configAllowNewer (\v flags -> flags { configAllowNewer = v}) - (optArg allowNewerArgument - (fmap Flag allowNewerParser) (Flag AllowNewerAll) - allowNewerPrinter) - ] - where allowNewerArgument = "DEPS" instance Monoid ConfigExFlags where mempty = ConfigExFlags { configCabalVersion = mempty, configExConstraints= mempty, configPreferences = mempty, - configSolver = mempty, - configAllowNewer = mempty + configSolver = mempty } mappend = (<>) @@ -494,8 +489,7 @@ instance Semigroup ConfigExFlags where configCabalVersion = combine configCabalVersion, configExConstraints= combine configExConstraints, configPreferences = combine configPreferences, - configSolver = combine configSolver, - configAllowNewer = combine configAllowNewer + configSolver = combine configSolver } where combine field = field a `mappend` field b @@ -1242,27 +1236,6 @@ defaultInstallFlags = InstallFlags { docIndexFile = toPathTemplate ("$datadir" "doc" "$arch-$os-$compiler" "index.html") -allowNewerParser :: ReadE AllowNewer -allowNewerParser = ReadE $ \s -> - case s of - "" -> Right AllowNewerNone - "False" -> Right AllowNewerNone - "True" -> Right AllowNewerAll - _ -> - case readPToMaybe pkgsParser s of - Just pkgs -> Right . AllowNewerSome $ pkgs - Nothing -> Left ("Cannot parse the list of packages: " ++ s) - where - pkgsParser = Parse.sepBy1 parse (Parse.char ',') - -allowNewerPrinter :: Flag AllowNewer -> [Maybe String] -allowNewerPrinter (Flag AllowNewerNone) = [Just "False"] -allowNewerPrinter (Flag AllowNewerAll) = [Just "True"] -allowNewerPrinter (Flag (AllowNewerSome pkgs)) = - [Just . intercalate "," . map display $ pkgs] -allowNewerPrinter NoFlag = [] - - defaultMaxBackjumps :: Int defaultMaxBackjumps = 2000 @@ -2290,10 +2263,6 @@ parsePackageArgs = parsePkgArgs [] show arg ++ " is not valid syntax for a package name or" ++ " package dependency." -readPToMaybe :: Parse.ReadP a a -> String -> Maybe a -readPToMaybe p str = listToMaybe [ r | (r,s) <- Parse.readP_to_S p str - , all isSpace s ] - parseDependencyOrPackageId :: Parse.ReadP r Dependency parseDependencyOrPackageId = parse Parse.+++ liftM pkgidToDependency parse where From 5eeae07968352ff3c55825a81976c05dfb85852e Mon Sep 17 00:00:00 2001 From: Mikhail Glushenkov Date: Fri, 19 Feb 2016 00:09:19 +0100 Subject: [PATCH 3/7] Support 'Setup.hs configure --allow-newer'. --- Cabal/Distribution/Simple/Configure.hs | 25 +++++++++++-- .../Distribution/Client/Dependency.hs | 36 ++++++------------- 2 files changed, 33 insertions(+), 28 deletions(-) diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index 1b4b21291f9..64dd82531c3 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -48,6 +48,7 @@ module Distribution.Simple.Configure (configure, ConfigStateFileError(..), tryGetConfigStateFile, platformDefines, + relaxPackageDeps, ) where @@ -787,6 +788,19 @@ dependencySatisfiable isInternalDep = not . null $ PackageIndex.lookupDependency internalPackageSet d +-- | Relax the dependencies of this package if needed +relaxPackageDeps :: AllowNewer -> GenericPackageDescription + -> GenericPackageDescription +relaxPackageDeps AllowNewerNone = id +relaxPackageDeps AllowNewerAll = + transformAllBuildDepends $ \(Dependency pkgName verRange) -> + Dependency pkgName (removeUpperBound verRange) +relaxPackageDeps (AllowNewerSome pkgNames) = + transformAllBuildDepends $ \d@(Dependency pkgName verRange) -> + if pkgName `elem` pkgNames + then Dependency pkgName (removeUpperBound verRange) + else d + -- | Finalize a generic package description. The workhorse is -- 'finalizePackageDescription' but there's a bit of other nattering -- about necessary. @@ -813,8 +827,15 @@ configureFinalizedPackage verbosity cfg flaggedBenchmarks = map (\(n, bm) -> (n, mapTreeData enableBenchmark bm)) (condBenchmarks pkg_descr0) - pkg_descr0'' = pkg_descr0 { condTestSuites = flaggedTests - , condBenchmarks = flaggedBenchmarks } + pkg_descr0''' = + -- Ignore '--allow-newer' when we're given '--exact-configuration'. + if fromFlagOrDefault False (configExactConfiguration cfg) + then pkg_descr0 + else relaxPackageDeps + (fromFlagOrDefault AllowNewerNone $ configAllowNewer cfg) + pkg_descr0 + pkg_descr0'' = pkg_descr0''' { condTestSuites = flaggedTests + , condBenchmarks = flaggedBenchmarks } (pkg_descr0', flags) <- case finalizePackageDescription diff --git a/cabal-install/Distribution/Client/Dependency.hs b/cabal-install/Distribution/Client/Dependency.hs index 52ff4cbc729..79d819129eb 100644 --- a/cabal-install/Distribution/Client/Dependency.hs +++ b/cabal-install/Distribution/Client/Dependency.hs @@ -96,12 +96,12 @@ import qualified Distribution.PackageDescription as PD , GenericPackageDescription(..) , Flag(flagName), FlagName(..) ) import Distribution.PackageDescription.Configuration - ( finalizePackageDescription, transformAllBuildDepends ) + ( finalizePackageDescription ) import Distribution.Client.PackageUtils ( externalBuildDepends ) import Distribution.Version ( VersionRange, anyVersion, thisVersion, withinRange - , removeUpperBound, simplifyVersionRange ) + , simplifyVersionRange ) import Distribution.Compiler ( CompilerInfo(..) ) import Distribution.System @@ -110,6 +110,8 @@ import Distribution.Client.Utils ( duplicates, duplicatesBy, mergeBy, MergeResult(..) ) import Distribution.Simple.Utils ( comparing, warn, info ) +import Distribution.Simple.Configure + ( relaxPackageDeps ) import Distribution.Simple.Setup ( AllowNewer(..) ) import Distribution.Text @@ -363,35 +365,17 @@ hideBrokenInstalledPackages params = -- 'addSourcePackages' won't have upper bounds in dependencies relaxed. -- removeUpperBounds :: AllowNewer -> DepResolverParams -> DepResolverParams -removeUpperBounds allowNewer params = +removeUpperBounds AllowNewerNone params = params +removeUpperBounds allowNewer params = params { depResolverSourcePkgIndex = sourcePkgIndex' } where - sourcePkgIndex = depResolverSourcePkgIndex params - sourcePkgIndex' = case allowNewer of - AllowNewerNone -> sourcePkgIndex - AllowNewerAll -> fmap relaxAllPackageDeps sourcePkgIndex - AllowNewerSome pkgs -> fmap (relaxSomePackageDeps pkgs) sourcePkgIndex - - relaxAllPackageDeps :: SourcePackage -> SourcePackage - relaxAllPackageDeps = onAllBuildDepends doRelax - where - doRelax (Dependency pkgName verRange) = - Dependency pkgName (removeUpperBound verRange) + sourcePkgIndex' = fmap relaxDeps $ depResolverSourcePkgIndex params - relaxSomePackageDeps :: [PackageName] -> SourcePackage -> SourcePackage - relaxSomePackageDeps pkgNames = onAllBuildDepends doRelax - where - doRelax d@(Dependency pkgName verRange) - | pkgName `elem` pkgNames = Dependency pkgName - (removeUpperBound verRange) - | otherwise = d - - onAllBuildDepends :: (Dependency -> Dependency) - -> SourcePackage -> SourcePackage - onAllBuildDepends f srcPkg = srcPkg { - packageDescription = transformAllBuildDepends f + relaxDeps :: SourcePackage -> SourcePackage + relaxDeps srcPkg = srcPkg { + packageDescription = relaxPackageDeps allowNewer (packageDescription srcPkg) } From ba0d7b22004a3e305c9281bf297f5504bae22d20 Mon Sep 17 00:00:00 2001 From: Mikhail Glushenkov Date: Fri, 19 Feb 2016 00:21:42 +0100 Subject: [PATCH 4/7] Typo. --- .../UnitTests/Distribution/Client/Dependency/Modular/DSL.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs index 91a00ac6d28..f0e0e4aa456 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs @@ -66,7 +66,7 @@ import qualified Distribution.Client.ComponentDeps as CD * The difference between `GenericPackageDescription` and `PackageDescription` is that `PackageDescription` describes a particular _configuration_ of a package (for instance, see documentation for `checkPackage`). A - `GenericPackageDescription` can be returned into a `PackageDescription` in + `GenericPackageDescription` can be turned into a `PackageDescription` in two ways: a. `finalizePackageDescription` does the proper translation, by taking From a9334ad90ac25773e4edf4b33cdd2aa8cd11f4d1 Mon Sep 17 00:00:00 2001 From: Mikhail Glushenkov Date: Fri, 19 Feb 2016 00:48:46 +0100 Subject: [PATCH 5/7] Whitespace. --- Cabal/tests/PackageTests/Tests.hs | 14 ++++++++++++++ HACKING.md | 4 ++-- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/Cabal/tests/PackageTests/Tests.hs b/Cabal/tests/PackageTests/Tests.hs index 37236721f5f..febd5e7b41f 100644 --- a/Cabal/tests/PackageTests/Tests.hs +++ b/Cabal/tests/PackageTests/Tests.hs @@ -221,6 +221,20 @@ nonSharedLibTests config = cabal_build ["--enable-tests"] cabal "test" [] + -- Test that '--allow-newer' works via the 'Setup.hs configure' interface. + , tc "AllowNewer" $ do + shouldFail $ cabal "configure" [] + cabal "configure" ["--allow-newer"] + shouldFail $ cabal "configure" ["--allow-newer=baz,quux"] + cabal "configure" ["--allow-newer=base", "--allow-newer=baz,quux"] + shouldFail $ cabal "configure" ["--enable-tests"] + cabal "configure" ["--enable-tests", "--allow-newer"] + shouldFail $ cabal "configure" ["--enable-benchmarks"] + cabal "configure" ["--enable-benchmarks", "--allow-newer"] + shouldFail $ cabal "configure" ["--enable-benchmarks", "--enable-tests"] + cabal "configure" ["--enable-benchmarks", "--enable-tests" + ,"--allow-newer"] + -- Test that Cabal can choose flags to disable building a component when that -- component's dependencies are unavailable. The build should succeed without -- requiring the component's dependencies or imports. diff --git a/HACKING.md b/HACKING.md index cef49387ac8..0b4595c0e76 100644 --- a/HACKING.md +++ b/HACKING.md @@ -70,7 +70,7 @@ To build and test the `Cabal` library, do: we cannot use `cabal` for the next steps; we need to use Setup instead. So, compile Setup.hs: - + ~~~~ ghc --make -threaded Setup.hs ~~~~ @@ -89,7 +89,7 @@ To build and test the `Cabal` library, do: ~~~~ ~/MyHaskellCode/cabal/Cabal/.cabal-sandbox/$SOMESTUFF-packages.conf.d ~~~~ - + (or, as a relative path with my setup:) ~~~~ From cd61c58d982f0948f6bca62acd7e5602040dcda1 Mon Sep 17 00:00:00 2001 From: Mikhail Glushenkov Date: Fri, 19 Feb 2016 01:51:44 +0100 Subject: [PATCH 6/7] Tests for './Setup --allow-newer'. --- Cabal/Cabal.cabal | 4 +++ .../PackageTests/AllowNewer/AllowNewer.cabal | 25 +++++++++++++++++++ .../AllowNewer/benchmarks/Bench.hs | 4 +++ .../tests/PackageTests/AllowNewer/src/Foo.hs | 4 +++ .../PackageTests/AllowNewer/tests/Test.hs | 4 +++ Cabal/tests/PackageTests/Tests.hs | 2 ++ 6 files changed, 43 insertions(+) create mode 100644 Cabal/tests/PackageTests/AllowNewer/AllowNewer.cabal create mode 100644 Cabal/tests/PackageTests/AllowNewer/benchmarks/Bench.hs create mode 100644 Cabal/tests/PackageTests/AllowNewer/src/Foo.hs create mode 100644 Cabal/tests/PackageTests/AllowNewer/tests/Test.hs diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 7abde38ade7..15fb8e74a89 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -32,6 +32,10 @@ extra-source-files: -- Generated with 'misc/gen-extra-source-files.sh' -- Do NOT edit this section manually; instead, run the script. -- BEGIN gen-extra-source-files + tests/PackageTests/AllowNewer/AllowNewer.cabal + tests/PackageTests/AllowNewer/benchmarks/Bench.hs + tests/PackageTests/AllowNewer/src/Foo.hs + tests/PackageTests/AllowNewer/tests/Test.hs tests/PackageTests/BenchmarkExeV10/Foo.hs tests/PackageTests/BenchmarkExeV10/benchmarks/bench-Foo.hs tests/PackageTests/BenchmarkExeV10/my.cabal diff --git a/Cabal/tests/PackageTests/AllowNewer/AllowNewer.cabal b/Cabal/tests/PackageTests/AllowNewer/AllowNewer.cabal new file mode 100644 index 00000000000..1fd1cc7d574 --- /dev/null +++ b/Cabal/tests/PackageTests/AllowNewer/AllowNewer.cabal @@ -0,0 +1,25 @@ +name: AllowNewer +version: 0.1.0.0 +license: BSD3 +author: Foo Bar +maintainer: cabal-dev@haskell.org +build-type: Simple +cabal-version: >=1.10 + +library + exposed-modules: Foo + hs-source-dirs: src + build-depends: base < 1 + default-language: Haskell2010 + +test-suite foo-test + type: exitcode-stdio-1.0 + main-is: Test.hs + hs-source-dirs: tests + build-depends: base < 1 + +benchmark foo-bench + type: exitcode-stdio-1.0 + main-is: Bench.hs + hs-source-dirs: benchmarks + build-depends: base < 1 diff --git a/Cabal/tests/PackageTests/AllowNewer/benchmarks/Bench.hs b/Cabal/tests/PackageTests/AllowNewer/benchmarks/Bench.hs new file mode 100644 index 00000000000..d82a4bd93b7 --- /dev/null +++ b/Cabal/tests/PackageTests/AllowNewer/benchmarks/Bench.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = return () diff --git a/Cabal/tests/PackageTests/AllowNewer/src/Foo.hs b/Cabal/tests/PackageTests/AllowNewer/src/Foo.hs new file mode 100644 index 00000000000..d82a4bd93b7 --- /dev/null +++ b/Cabal/tests/PackageTests/AllowNewer/src/Foo.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = return () diff --git a/Cabal/tests/PackageTests/AllowNewer/tests/Test.hs b/Cabal/tests/PackageTests/AllowNewer/tests/Test.hs new file mode 100644 index 00000000000..170ccdb527c --- /dev/null +++ b/Cabal/tests/PackageTests/AllowNewer/tests/Test.hs @@ -0,0 +1,4 @@ +!module Main where + +main :: IO () +main = return () diff --git a/Cabal/tests/PackageTests/Tests.hs b/Cabal/tests/PackageTests/Tests.hs index febd5e7b41f..93a00dec0dd 100644 --- a/Cabal/tests/PackageTests/Tests.hs +++ b/Cabal/tests/PackageTests/Tests.hs @@ -227,6 +227,8 @@ nonSharedLibTests config = cabal "configure" ["--allow-newer"] shouldFail $ cabal "configure" ["--allow-newer=baz,quux"] cabal "configure" ["--allow-newer=base", "--allow-newer=baz,quux"] + cabal "configure" ["--allow-newer=bar", "--allow-newer=base,baz" + ,"--allow-newer=quux"] shouldFail $ cabal "configure" ["--enable-tests"] cabal "configure" ["--enable-tests", "--allow-newer"] shouldFail $ cabal "configure" ["--enable-benchmarks"] From 53cfe17da194521cf4c37f3556bb2d7d1813c091 Mon Sep 17 00:00:00 2001 From: Mikhail Glushenkov Date: Fri, 19 Feb 2016 01:53:12 +0100 Subject: [PATCH 7/7] Fix '--allow-newer' bugs caught by tests. * Fix parsing of '--allow-newer=foo --allow-newer=bar'. * Fix './Setup configure --allow-newer --enable-{tests, benchmarks}'. --- Cabal/Distribution/Simple/Configure.hs | 19 ++++++++------- Cabal/Distribution/Simple/Setup.hs | 23 ++++++++----------- Cabal/changelog | 2 ++ cabal-install/Distribution/Client/Config.hs | 8 ++++++- .../Distribution/Client/Configure.hs | 8 +++---- cabal-install/Distribution/Client/Install.hs | 2 +- cabal-install/Distribution/Client/Setup.hs | 2 +- cabal-install/changelog | 2 ++ 8 files changed, 34 insertions(+), 32 deletions(-) diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index 64dd82531c3..a67baa63f21 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -310,7 +310,13 @@ findDistPrefOrDefault = findDistPref defaultDistPref -- Returns the @.setup-config@ file. configure :: (GenericPackageDescription, HookedBuildInfo) -> ConfigFlags -> IO LocalBuildInfo -configure (pkg_descr0, pbi) cfg = do +configure (pkg_descr0', pbi) cfg = do + let pkg_descr0 = + -- Ignore '--allow-newer' when we're given '--exact-configuration'. + if fromFlagOrDefault False (configExactConfiguration cfg) + then pkg_descr0' + else relaxPackageDeps (configAllowNewer cfg) pkg_descr0' + setupMessage verbosity "Configuring" (packageId pkg_descr0) checkDeprecatedFlags verbosity cfg @@ -827,15 +833,8 @@ configureFinalizedPackage verbosity cfg flaggedBenchmarks = map (\(n, bm) -> (n, mapTreeData enableBenchmark bm)) (condBenchmarks pkg_descr0) - pkg_descr0''' = - -- Ignore '--allow-newer' when we're given '--exact-configuration'. - if fromFlagOrDefault False (configExactConfiguration cfg) - then pkg_descr0 - else relaxPackageDeps - (fromFlagOrDefault AllowNewerNone $ configAllowNewer cfg) - pkg_descr0 - pkg_descr0'' = pkg_descr0''' { condTestSuites = flaggedTests - , condBenchmarks = flaggedBenchmarks } + pkg_descr0'' = pkg_descr0 { condTestSuites = flaggedTests + , condBenchmarks = flaggedBenchmarks } (pkg_descr0', flags) <- case finalizePackageDescription diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index b5bf4c9fd35..9f10f30f7d0 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/Cabal/Distribution/Simple/Setup.hs @@ -299,12 +299,11 @@ allowNewerParser = ReadE $ \s -> where pkgsParser = Parse.sepBy1 parse (Parse.char ',') -allowNewerPrinter :: Flag AllowNewer -> [Maybe String] -allowNewerPrinter (Flag AllowNewerNone) = [Just "False"] -allowNewerPrinter (Flag AllowNewerAll) = [Just "True"] -allowNewerPrinter (Flag (AllowNewerSome pkgs)) = +allowNewerPrinter :: AllowNewer -> [Maybe String] +allowNewerPrinter AllowNewerNone = [] +allowNewerPrinter AllowNewerAll = [Nothing] +allowNewerPrinter (AllowNewerSome pkgs) = [Just . intercalate "," . map display $ pkgs] -allowNewerPrinter NoFlag = [] -- | Flags to @configure@ command. -- @@ -374,7 +373,8 @@ 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. - configAllowNewer :: Flag AllowNewer -- ^ + configAllowNewer :: AllowNewer -- ^ Ignore upper bounds on all or some + -- dependencies. } deriving (Generic, Read, Show) @@ -421,7 +421,7 @@ defaultConfigFlags progConf = emptyConfigFlags { configFlagError = NoFlag, configRelocatable = Flag False, configDebugInfo = Flag NoDebugInfo, - configAllowNewer = NoFlag + configAllowNewer = AllowNewerNone } configureCommand :: ProgramConfiguration -> CommandUI ConfigFlags @@ -661,9 +661,7 @@ configureOptions showOrParseArgs = ,option [] ["allow-newer"] ("Ignore upper bounds in all dependencies or DEPS") configAllowNewer (\v flags -> flags { configAllowNewer = v}) - (optArg "DEPS" - (fmap Flag allowNewerParser) (Flag AllowNewerAll) - allowNewerPrinter) + (optArg "DEPS" allowNewerParser AllowNewerAll allowNewerPrinter) ,option "" ["exact-configuration"] "All direct dependencies and flags are provided on the command line." @@ -882,12 +880,9 @@ instance Semigroup ConfigFlags where configFlagError = combine configFlagError, configRelocatable = combine configRelocatable, configDebugInfo = combine configDebugInfo, - configAllowNewer = combineAllowNewer (configAllowNewer a) - (configAllowNewer b) + configAllowNewer = combine configAllowNewer } where combine field = field a `mappend` field b - combineAllowNewer (Flag fa) (Flag fb) = (Flag $ fa `mappend` fb) - combineAllowNewer fa fb = fa `mappend` fb -- ------------------------------------------------------------ -- * Copy flags diff --git a/Cabal/changelog b/Cabal/changelog index 2f4d7a92334..979ea1e0bc1 100644 --- a/Cabal/changelog +++ b/Cabal/changelog @@ -19,6 +19,8 @@ work-around for #2398) * Library support for multi-instance package DBs (#2948). * Improved the './Setup configure' solver (#3082, #3076). + * The '--allow-newer' option can be now used with './Setup + configure' (#3163). 1.22.0.0 Johan Tibell January 2015 * Support GHC 7.10. diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs index 784ca02157e..da8e762bdfb 100644 --- a/cabal-install/Distribution/Client/Config.hs +++ b/cabal-install/Distribution/Client/Config.hs @@ -204,6 +204,11 @@ instance Semigroup SavedConfig where combine' field subfield = (subfield . field $ a) `mappend` (subfield . field $ b) + combineMonoid :: Monoid mon => (SavedConfig -> flags) -> (flags -> mon) + -> mon + combineMonoid field subfield = + (subfield . field $ a) `mappend` (subfield . field $ b) + lastNonEmpty' :: (SavedConfig -> flags) -> (flags -> [a]) -> [a] lastNonEmpty' field subfield = let a' = subfield . field $ a @@ -325,7 +330,8 @@ instance Semigroup SavedConfig where configExactConfiguration = combine configExactConfiguration, configFlagError = combine configFlagError, configRelocatable = combine configRelocatable, - configAllowNewer = combine configAllowNewer + configAllowNewer = combineMonoid savedConfigureFlags + configAllowNewer } where combine = combine' savedConfigureFlags diff --git a/cabal-install/Distribution/Client/Configure.hs b/cabal-install/Distribution/Client/Configure.hs index c0133b5b637..c8e717959ac 100644 --- a/cabal-install/Distribution/Client/Configure.hs +++ b/cabal-install/Distribution/Client/Configure.hs @@ -63,7 +63,7 @@ import Distribution.Version import Distribution.Simple.Utils as Utils ( warn, notice, info, debug, die ) import Distribution.Simple.Setup - ( AllowNewer(..), isAllowNewer ) + ( isAllowNewer ) import Distribution.System ( Platform ) import Distribution.Text ( display ) @@ -86,8 +86,7 @@ chooseCabalVersion configFlags maybeVersion = where -- Cabal < 1.19.2 doesn't support '--exact-configuration' which is needed -- for '--allow-newer' to work. - allowNewer = fromFlagOrDefault False $ - fmap isAllowNewer (configAllowNewer configFlags) + allowNewer = isAllowNewer (configAllowNewer configFlags) defaultVersionRange = if allowNewer then orLaterVersion (Version [1,19,2] []) @@ -289,8 +288,7 @@ planLocalPackage verbosity comp platform configFlags configExFlags fromFlagOrDefault False $ configBenchmarks configFlags resolverParams = - removeUpperBounds (fromFlagOrDefault AllowNewerNone $ - configAllowNewer configFlags) + removeUpperBounds (configAllowNewer configFlags) . addPreferences -- preferences from the config file or command line diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index 40eefd3d4b1..7dc5225d561 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -417,7 +417,7 @@ planPackages comp platform mSandboxPkgInfo solver maxBackjumps = fromFlag (installMaxBackjumps installFlags) upgradeDeps = fromFlag (installUpgradeDeps installFlags) onlyDeps = fromFlag (installOnlyDeps installFlags) - allowNewer = fromFlag (configAllowNewer configFlags) + allowNewer = (configAllowNewer configFlags) -- | Remove the provided targets from the install plan. pruneInstallPlan :: Package targetpkg diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index 7966ccba8b9..182e0c3d771 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -370,7 +370,7 @@ filterConfigureFlags flags cabalLibVersion configConstraints = [], -- Passing '--allow-newer' to Setup.hs is unnecessary, we use -- '--exact-configuration' instead. - configAllowNewer = NoFlag + configAllowNewer = Cabal.AllowNewerNone } -- Cabal < 1.23 doesn't know about '--profiling-detail'. diff --git a/cabal-install/changelog b/cabal-install/changelog index 521880cc293..7514923e5c7 100644 --- a/cabal-install/changelog +++ b/cabal-install/changelog @@ -42,6 +42,8 @@ default location or as specified by --config-file (#2553). * The man page for 'cabal-install' is now automatically generated (#2877). + * The '--allow-newer' option now works as expected when specified + multiple times (#2588). 1.22.0.0 Johan Tibell January 2015 * New command: user-config (#2159).