From 2385f79f615ff796f130bf71adeaecf751f8f58b Mon Sep 17 00:00:00 2001 From: Kristen Kozak Date: Sun, 29 Jan 2017 16:10:38 -0800 Subject: [PATCH] Expose constraints that apply wherever a package appears in the dependency graph. For example, --constraint="any.pkg == 5" applies to "pkg" whether it is a top-level dependency, setup dependency, or build tool dependency. I also modified the UserConstraint type so that it is more similar to the PackageConstraint type, now that both types need to express similar "constraint scopes". --- Cabal/doc/installing-packages.rst | 6 + .../Distribution/Client/CmdFreeze.hs | 10 +- cabal-install/Distribution/Client/Freeze.hs | 2 +- cabal-install/Distribution/Client/Targets.hs | 133 +++++++++++------- cabal-install/changelog | 3 +- .../Distribution/Client/ProjectConfig.hs | 17 ++- .../UnitTests/Distribution/Client/Targets.hs | 24 ++-- .../install-time-with-constraint.test.hs | 9 +- 8 files changed, 128 insertions(+), 76 deletions(-) diff --git a/Cabal/doc/installing-packages.rst b/Cabal/doc/installing-packages.rst index 2b26ed85224..ac8abe3bf0d 100644 --- a/Cabal/doc/installing-packages.rst +++ b/Cabal/doc/installing-packages.rst @@ -1313,6 +1313,12 @@ Miscellaneous options tool dependency, you can add a qualifier to the constraint as follows: + :: + + # Example use of the 'any' qualifier. This constraint + # applies to package bar anywhere in the dependency graph. + $ cabal install --constraint="any.bar == 1.0" + :: # Example use of the 'setup' qualifier. This constraint diff --git a/cabal-install/Distribution/Client/CmdFreeze.hs b/cabal-install/Distribution/Client/CmdFreeze.hs index 581202782fe..2a3ad2aa4f2 100644 --- a/cabal-install/Distribution/Client/CmdFreeze.hs +++ b/cabal-install/Distribution/Client/CmdFreeze.hs @@ -13,7 +13,7 @@ import Distribution.Client.ProjectConfig , commandLineFlagsToProjectConfig, writeProjectLocalFreezeConfig , findProjectRoot, getProjectFileName ) import Distribution.Client.Targets - ( UserQualifier(..), UserConstraint(..) ) + ( UserQualifier(..), UserConstraintScope(..), UserConstraint(..) ) import Distribution.Solver.Types.PackageConstraint ( PackageProperty(..) ) import Distribution.Solver.Types.ConstraintSource @@ -150,7 +150,7 @@ projectFreezeConstraints plan = versionConstraints :: Map PackageName [(UserConstraint, ConstraintSource)] versionConstraints = Map.mapWithKey - (\p v -> [(UserConstraint UserToplevel p (PackagePropertyVersion v), + (\p v -> [(UserConstraint (UserQualified UserQualToplevel p) (PackagePropertyVersion v), ConstraintSourceFreeze)]) versionRanges @@ -168,7 +168,7 @@ projectFreezeConstraints plan = flagConstraints :: Map PackageName [(UserConstraint, ConstraintSource)] flagConstraints = Map.mapWithKey - (\p f -> [(UserConstraint UserToplevel p (PackagePropertyFlags f), + (\p f -> [(UserConstraint (UserQualified UserQualToplevel p) (PackagePropertyFlags f), ConstraintSourceFreeze)]) flagAssignments @@ -205,8 +205,8 @@ projectFreezeConstraints plan = else Just constraints) #endif - isVersionConstraint (UserConstraint _ _ (PackagePropertyVersion _)) = True - isVersionConstraint _ = False + isVersionConstraint (UserConstraint _ (PackagePropertyVersion _)) = True + isVersionConstraint _ = False localPackages :: Map PackageName () localPackages = diff --git a/cabal-install/Distribution/Client/Freeze.hs b/cabal-install/Distribution/Client/Freeze.hs index 0fd256b4cea..27d57dbfcc5 100644 --- a/cabal-install/Distribution/Client/Freeze.hs +++ b/cabal-install/Distribution/Client/Freeze.hs @@ -253,7 +253,7 @@ freezePackages verbosity globalFlags pkgs = do ,ConstraintSourceUserConfig userPackageEnvironmentFile) where pkgIdToConstraint pkgId = - UserConstraint UserToplevel (packageName pkgId) + UserConstraint (UserQualified UserQualToplevel (packageName pkgId)) (PackagePropertyVersion $ thisVersion (packageVersion pkgId)) createPkgEnv config = mempty { pkgEnvSavedConfig = config } showPkgEnv = BS.Char8.pack . showPackageEnvironment diff --git a/cabal-install/Distribution/Client/Targets.hs b/cabal-install/Distribution/Client/Targets.hs index a02669909ae..b8f25c71af0 100644 --- a/cabal-install/Distribution/Client/Targets.hs +++ b/cabal-install/Distribution/Client/Targets.hs @@ -44,6 +44,7 @@ module Distribution.Client.Targets ( -- * User constraints UserQualifier(..), + UserConstraintScope(..), UserConstraint(..), userConstraintPackageName, readUserConstraint, @@ -113,8 +114,6 @@ import Distribution.Compat.ReadP ( (+++), (<++) ) import Distribution.ParseUtils ( readPToMaybe ) -import Text.PrettyPrint - ( (<+>) ) import System.FilePath ( takeExtension, dropExtension, takeDirectory, splitPath ) import System.Directory @@ -703,35 +702,56 @@ extraPackageNameEnv names = PackageNameEnv pkgNameLookup -- command line. data UserQualifier = -- | Top-level dependency. - UserToplevel + UserQualToplevel -- | Setup dependency. - | UserSetup PackageName + | UserQualSetup PackageName -- | Executable dependency. - | UserExe PackageName PackageName + | UserQualExe PackageName PackageName deriving (Eq, Show, Generic) - + instance Binary UserQualifier +-- | Version of 'ConstraintScope' that a user may specify on the +-- command line. +data UserConstraintScope = + -- | Scope that applies to the package when it has the specified qualifier. + UserQualified UserQualifier PackageName + + -- | Scope that applies to the package when it has any qualifier. + | UserAnyQualifier PackageName + deriving (Eq, Show, Generic) + +instance Binary UserConstraintScope + fromUserQualifier :: UserQualifier -> Qualifier -fromUserQualifier UserToplevel = QualToplevel -fromUserQualifier (UserSetup name) = QualSetup name -fromUserQualifier (UserExe name1 name2) = QualExe name1 name2 +fromUserQualifier UserQualToplevel = QualToplevel +fromUserQualifier (UserQualSetup name) = QualSetup name +fromUserQualifier (UserQualExe name1 name2) = QualExe name1 name2 + +fromUserConstraintScope :: UserConstraintScope -> ConstraintScope +fromUserConstraintScope (UserQualified q pn) = + ScopeQualified (fromUserQualifier q) pn +fromUserConstraintScope (UserAnyQualifier pn) = ScopeAnyQualifier pn -- | Version of 'PackageConstraint' that the user can specify on -- the command line. -data UserConstraint = UserConstraint UserQualifier PackageName PackageProperty +data UserConstraint = + UserConstraint UserConstraintScope PackageProperty deriving (Eq, Show, Generic) instance Binary UserConstraint userConstraintPackageName :: UserConstraint -> PackageName -userConstraintPackageName (UserConstraint _ name _) = name +userConstraintPackageName (UserConstraint scope _) = scopePN scope + where + scopePN (UserQualified _ pn) = pn + scopePN (UserAnyQualifier pn) = pn userToPackageConstraint :: UserConstraint -> PackageConstraint -userToPackageConstraint (UserConstraint qual name prop) = - PackageConstraint (ScopeQualified (fromUserQualifier qual) name) prop +userToPackageConstraint (UserConstraint scope prop) = + PackageConstraint (fromUserConstraintScope scope) prop readUserConstraint :: String -> Either String UserConstraint readUserConstraint str = @@ -745,45 +765,54 @@ readUserConstraint str = "'source', 'test', 'bench', or flags" instance Text UserConstraint where - disp (UserConstraint qual name prop) = - dispQualifier (fromUserQualifier qual) <<>> disp name - <+> dispPackageProperty prop + disp (UserConstraint scope prop) = + dispPackageConstraint $ PackageConstraint (fromUserConstraintScope scope) prop - parse = do - -- Qualified name - pn <- parse - (qual, name) <- return (UserToplevel, pn) - +++ - do _ <- Parse.string ":setup." - pn2 <- parse - return (UserSetup pn, pn2) - - -- -- TODO: Re-enable parsing of UserExe once we decide on a syntax. - -- - -- +++ - -- do _ <- Parse.string ":" - -- pn2 <- parse - -- _ <- Parse.string ":exe." - -- pn3 <- parse - -- return (UserExe pn pn2, pn3) + parse = + let parseConstraintScope :: Parse.ReadP a UserConstraintScope + parseConstraintScope = + do + _ <- Parse.string "any." + pn <- parse + return (UserAnyQualifier pn) + +++ + do + -- Qualified name + pn <- parse + (return (UserQualified UserQualToplevel pn) + +++ + do _ <- Parse.string ":setup." + pn2 <- parse + return (UserQualified (UserQualSetup pn) pn2)) + + -- -- TODO: Re-enable parsing of UserQualExe once we decide on a syntax. + -- + -- +++ + -- do _ <- Parse.string ":" + -- pn2 <- parse + -- _ <- Parse.string ":exe." + -- pn3 <- parse + -- return (UserQualExe pn pn2, pn3) + in do + scope <- parseConstraintScope - -- Package property - let keyword str x = Parse.skipSpaces1 >> Parse.string str >> return x - prop <- ((parse >>= return . PackagePropertyVersion) - +++ - keyword "installed" PackagePropertyInstalled - +++ - keyword "source" PackagePropertySource - +++ - keyword "test" (PackagePropertyStanzas [TestStanzas]) - +++ - keyword "bench" (PackagePropertyStanzas [BenchStanzas])) - -- Note: the parser is left-biased here so that we - -- don't get an ambiguous parse from 'installed', - -- 'source', etc. being regarded as flags. - <++ - (Parse.skipSpaces1 >> parseFlagAssignment - >>= return . PackagePropertyFlags) + -- Package property + let keyword str x = Parse.skipSpaces1 >> Parse.string str >> return x + prop <- ((parse >>= return . PackagePropertyVersion) + +++ + keyword "installed" PackagePropertyInstalled + +++ + keyword "source" PackagePropertySource + +++ + keyword "test" (PackagePropertyStanzas [TestStanzas]) + +++ + keyword "bench" (PackagePropertyStanzas [BenchStanzas])) + -- Note: the parser is left-biased here so that we + -- don't get an ambiguous parse from 'installed', + -- 'source', etc. being regarded as flags. + <++ + (Parse.skipSpaces1 >> parseFlagAssignment + >>= return . PackagePropertyFlags) - -- Result - return (UserConstraint qual name prop) + -- Result + return (UserConstraint scope prop) diff --git a/cabal-install/changelog b/cabal-install/changelog index d28ec738ddf..56a44b025dd 100644 --- a/cabal-install/changelog +++ b/cabal-install/changelog @@ -41,7 +41,8 @@ on bar (part of #3502). * Non-qualified constraints, such as --constraint="bar == 1.0", now only apply to top-level dependencies. They don't constrain setup or - build-tool dependencies. + build-tool dependencies. The new syntax --constraint="any.bar == 1.0" + constrains all uses of bar. 1.24.0.0 Ryan Thomas March 2016 * If there are multiple remote repos, 'cabal update' now updates diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs index a5e93a6c384..7b912940a1a 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs @@ -203,7 +203,7 @@ hackProjectConfigShared config = projectConfigConstraints = --TODO: [required eventually] parse ambiguity in constraint -- "pkgname -any" as either any version or disabled flag "any". - let ambiguous (UserConstraint _ _ (PackagePropertyFlags flags), _) = + let ambiguous (UserConstraint _ (PackagePropertyFlags flags), _) = (not . null) [ () | (name, False) <- flags , "any" `isPrefixOf` unFlagName name ] ambiguous _ = False @@ -565,16 +565,21 @@ instance Arbitrary RemoteRepo where shortListOf1 5 (oneof [ choose ('0', '9') , choose ('a', 'f') ]) +instance Arbitrary UserConstraintScope where + arbitrary = oneof [ UserQualified <$> arbitrary <*> arbitrary + , UserAnyQualifier <$> arbitrary + ] + instance Arbitrary UserQualifier where - arbitrary = oneof [ pure UserToplevel - , UserSetup <$> arbitrary + arbitrary = oneof [ pure UserQualToplevel + , UserQualSetup <$> arbitrary - -- -- TODO: Re-enable UserExe tests once we decide on a syntax. - -- , UserExe <$> arbitrary <*> arbitrary + -- -- TODO: Re-enable UserQualExe tests once we decide on a syntax. + -- , UserQualExe <$> arbitrary <*> arbitrary ] instance Arbitrary UserConstraint where - arbitrary = UserConstraint <$> arbitrary <*> arbitrary <*> arbitrary + arbitrary = UserConstraint <$> arbitrary <*> arbitrary instance Arbitrary PackageProperty where arbitrary = oneof [ PackagePropertyVersion <$> arbitrary diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs b/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs index e823835e1fb..6c4079e1ff2 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs @@ -2,8 +2,9 @@ module UnitTests.Distribution.Client.Targets ( tests ) where -import Distribution.Client.Targets (UserQualifier(..), UserConstraint(..) - ,readUserConstraint) +import Distribution.Client.Targets (UserQualifier(..) + ,UserConstraintScope(..) + ,UserConstraint(..), readUserConstraint) import Distribution.Compat.ReadP (readP_to_S) import Distribution.Package (mkPackageName) import Distribution.PackageDescription (mkFlagName) @@ -12,6 +13,7 @@ import Distribution.ParseUtils (parseCommaList) import Distribution.Text (parse) import Distribution.Solver.Types.PackageConstraint (PackageProperty(..)) +import Distribution.Solver.Types.OptionalStanza (OptionalStanza(..)) import Test.Tasty import Test.Tasty.HUnit @@ -45,27 +47,31 @@ tests = exampleConstraints :: [(String, UserConstraint)] exampleConstraints = [ ("template-haskell installed", - UserConstraint UserToplevel (pn "template-haskell") + UserConstraint (UserQualified UserQualToplevel (pn "template-haskell")) PackagePropertyInstalled) , ("bytestring -any", - UserConstraint UserToplevel (pn "bytestring") + UserConstraint (UserQualified UserQualToplevel (pn "bytestring")) (PackagePropertyVersion anyVersion)) - + + , ("any.directory test", + UserConstraint (UserAnyQualifier (pn "directory")) + (PackagePropertyStanzas [TestStanzas])) + , ("process:setup.bytestring ==5.2", - UserConstraint (UserSetup (pn "process")) (pn "bytestring") + UserConstraint (UserQualified (UserQualSetup (pn "process")) (pn "bytestring")) (PackagePropertyVersion (thisVersion (mkVersion [5, 2])))) , ("network:setup.containers +foo -bar baz", - UserConstraint (UserSetup (pn "network")) (pn "containers") + UserConstraint (UserQualified (UserQualSetup (pn "network")) (pn "containers")) (PackagePropertyFlags [(fn "foo", True), (fn "bar", False), (fn "baz", True)])) - -- -- TODO: Re-enable UserExe tests once we decide on a syntax. + -- -- TODO: Re-enable UserQualExe tests once we decide on a syntax. -- -- , ("foo:happy:exe.template-haskell test", - -- UserConstraint (UserExe (pn "foo") (pn "happy")) (pn "template-haskell") + -- UserConstraint (UserQualified (UserQualExe (pn "foo") (pn "happy")) (pn "template-haskell")) -- (PackagePropertyStanzas [TestStanzas])) ] where diff --git a/cabal-testsuite/PackageTests/Regression/T4154/install-time-with-constraint.test.hs b/cabal-testsuite/PackageTests/Regression/T4154/install-time-with-constraint.test.hs index 11074178310..431d84d3ce1 100644 --- a/cabal-testsuite/PackageTests/Regression/T4154/install-time-with-constraint.test.hs +++ b/cabal-testsuite/PackageTests/Regression/T4154/install-time-with-constraint.test.hs @@ -4,5 +4,10 @@ import Test.Cabal.Prelude -- dependencies. cabal should be able to install the local time-99999 by -- building its setup script with the installed time, even though the installed -- time doesn't fit the constraint. -main = cabalTest $ withRepo "repo" $ - cabal "new-build" ["time", "--constraint=time==99999", "--dry-run"] +main = cabalTest $ withRepo "repo" $ do + cabal "new-build" ["time", "--constraint=time==99999", "--dry-run"] + + -- Constraining all uses of 'time' results in a cyclic dependency + -- between 'Cabal' and the new 'time'. + r <- fails $ cabal' "new-build" ["time", "--constraint=any.time==99999", "--dry-run"] + assertOutputContains "cyclic dependencies; conflict set: time:setup.Cabal, time:setup.time" r