Commit f9139d7b authored by kristenk's avatar kristenk Committed by Edward Z. Yang

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".
parent 3c06b132
......@@ -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
......
......@@ -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 =
......
......@@ -255,7 +255,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
......
......@@ -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)
......@@ -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 <ryan@ryant.org> March 2016
* If there are multiple remote repos, 'cabal update' now updates
......
......@@ -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
......
......@@ -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
......
......@@ -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
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment