Commit 8bcd719a authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺

Augment `--allow-{newer,older}` syntax to support wildcard

This builds on top of a0d80350 (#4575)
and extends the syntax to support the token `all` or `*` to serve as
wild-card for the relaxation subject, i.e. the following non-exhaustive
list of forms is made possible (NB: the package name `all` is reserved
on Hackage):

    allow-newer: somepkg:*
    allow-newer: somepkg:all
    allow-newer: somepkg:^*
    allow-newer: somepkg:^all
    allow-newer: all:^all
    allow-newer: *:^all
    allow-newer: *:^*
    allow-newer: *:*
    allow-newer: all:all

Refer to the user's guide for details
parent 4066ea7a
......@@ -754,16 +754,36 @@ The following settings control the behavior of the dependency solver:
-- Disregard all upper bounds when dependency solving
allow-newer: all
-- Disregard all `^>=`-style upper bounds when dependency solving
allow-newer: ^all
For consistency, there is also the explicit wildcard scope syntax
``*`` (or its alphabetic synonym ``all``). Consequently, the first
part of the example above is equivalent to the explicitly scoped
variant:
``*`` (or its alphabetic synonym ``all``). Consequently, the
examples above are equivalent to the explicitly scoped variants:
::
allow-newer: all:bar, *:baz, *:^quux
allow-newer: *:*
allow-newer: all:all
allow-newer: *:^*
allow-newer: all:^all
In order to ignore all bounds specified by a package ``pkg-1.2.3``
you can combine scoping with a right-hand-side wildcard like so
::
-- Disregard any upper bounds specified by pkg-1.2.3
allow-newer: pkg-1.2.3:*
-- Disregard only `^>=`-style upper bounds in pkg-1.2.3
allow-newer: pkg-1.2.3:^*
:cfg-field:`allow-newer` is often used in conjunction with a constraint
(in the cfg-field:`constraints` field) forcing the usage of a specific,
newer version of a package.
......
......@@ -73,7 +73,7 @@ import Distribution.Client.Types
( SourcePackageDb(SourcePackageDb)
, UnresolvedPkgLoc, UnresolvedSourcePackage
, AllowNewer(..), AllowOlder(..), RelaxDeps(..), RelaxedDep(..)
, RelaxDepScope(..), RelaxDepMod(..), isRelaxDeps
, RelaxDepScope(..), RelaxDepMod(..), RelaxDepSubject(..), isRelaxDeps
)
import Distribution.Client.Dependency.Types
( PreSolver(..), Solver(..)
......@@ -457,6 +457,7 @@ relaxPackageDeps :: RelaxKind
relaxPackageDeps _ rd gpd | not (isRelaxDeps rd) = gpd -- subsumed by no-op case in 'removeBounds'
relaxPackageDeps relKind RelaxDepsAll gpd = PD.transformAllBuildDepends relaxAll gpd
where
relaxAll :: Dependency -> Dependency
relaxAll (Dependency pkgName verRange) =
Dependency pkgName (removeBound relKind RelaxDepModNone verRange)
......@@ -467,7 +468,7 @@ relaxPackageDeps relKind (RelaxDepsSome depsToRelax0) gpd =
thisPkgId = packageId gpd
depsToRelax = Map.fromList $ mapMaybe f depsToRelax0
f :: RelaxedDep -> Maybe (PackageName,RelaxDepMod)
f :: RelaxedDep -> Maybe (RelaxDepSubject,RelaxDepMod)
f (RelaxedDep scope rdm p) = case scope of
RelaxDepScopeAll -> Just (p,rdm)
RelaxDepScopePackage p0
......@@ -479,7 +480,11 @@ relaxPackageDeps relKind (RelaxDepsSome depsToRelax0) gpd =
relaxSome :: Dependency -> Dependency
relaxSome d@(Dependency depName verRange)
| Just relMod <- Map.lookup depName depsToRelax =
| Just relMod <- Map.lookup RelaxDepSubjectAll depsToRelax =
-- a '*'-subject acts absorbing, for consistency with
-- the 'Semigroup RelaxDeps' instance
Dependency depName (removeBound relKind relMod verRange)
| Just relMod <- Map.lookup (RelaxDepSubjectPkg depName) depsToRelax =
Dependency depName (removeBound relKind relMod verRange)
| otherwise = d -- no-op
......
......@@ -25,8 +25,8 @@ import Distribution.Client.Compat.Prelude
import Distribution.Client.ProjectConfig.Types
import Distribution.Client.Types
( RemoteRepo(..), emptyRemoteRepo, isRelaxDeps
, AllowNewer(..), AllowOlder(..), RelaxDeps(..) )
( RemoteRepo(..), emptyRemoteRepo
, AllowNewer(..), AllowOlder(..) )
import Distribution.Client.Config
( SavedConfig(..), remoteRepoFields )
......@@ -830,12 +830,12 @@ legacySharedConfigFieldDescrs =
configPreferences (\v conf -> conf { configPreferences = v })
, simpleField "allow-older"
(maybe mempty dispRelaxDeps) (fmap Just parseRelaxDeps)
(maybe mempty disp) (fmap Just parse)
(fmap unAllowOlder . configAllowOlder)
(\v conf -> conf { configAllowOlder = fmap AllowOlder v })
, simpleField "allow-newer"
(maybe mempty dispRelaxDeps) (fmap Just parseRelaxDeps)
(maybe mempty disp) (fmap Just parse)
(fmap unAllowNewer . configAllowNewer)
(\v conf -> conf { configAllowNewer = fmap AllowNewer v })
]
......@@ -870,18 +870,6 @@ legacySharedConfigFieldDescrs =
where
constraintSrc = ConstraintSourceProjectConfig "TODO"
parseRelaxDeps :: ReadP r RelaxDeps
parseRelaxDeps =
((const mempty <$> (Parse.string "none" +++ Parse.string "None"))
+++ (const RelaxDepsAll <$> (Parse.string "all" +++ Parse.string "All")))
<++ ( RelaxDepsSome <$> parseOptCommaList parse)
dispRelaxDeps :: RelaxDeps -> Doc
dispRelaxDeps rd | not (isRelaxDeps rd) = Disp.text "None"
dispRelaxDeps (RelaxDepsSome pkgs) = Disp.fsep . Disp.punctuate Disp.comma
. map disp $ pkgs
dispRelaxDeps RelaxDepsAll = Disp.text "All"
legacyPackageConfigFieldDescrs :: [FieldDescr LegacyPackageConfig]
legacyPackageConfigFieldDescrs =
......
......@@ -42,7 +42,7 @@ import Distribution.Types.AnnotatedId
import Distribution.Types.UnitId
( UnitId )
import Distribution.Types.PackageName
( PackageName )
( PackageName, mkPackageName )
import Distribution.Types.ComponentName
( ComponentName(..) )
......@@ -56,6 +56,7 @@ import Distribution.Solver.Types.PackageFixedDeps
import Distribution.Solver.Types.SourcePackage
import Distribution.Compat.Graph (IsNode(..))
import qualified Distribution.Compat.ReadP as Parse
import Distribution.ParseUtils (parseOptCommaList)
import Distribution.Simple.Utils (ordNub)
import Distribution.Text (Text(..))
......@@ -403,12 +404,18 @@ data RelaxDeps =
RelaxDepsSome [RelaxedDep]
-- | Ignore upper bounds in dependencies on all packages.
--
-- __Note__: This is should be semantically equivalent to
--
-- > RelaxDepsSome [RelaxedDep RelaxDepScopeAll RelaxDepModNone RelaxDepSubjectAll]
--
-- (TODO: consider normalising 'RelaxDeps' and/or 'RelaxedDep')
| 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 !RelaxDepScope !RelaxDepMod !PackageName
data RelaxedDep = RelaxedDep !RelaxDepScope !RelaxDepMod !RelaxDepSubject
deriving (Eq, Read, Show, Generic)
-- | Specify the scope of a relaxation, i.e. limit which depending
......@@ -426,15 +433,20 @@ data RelaxDepMod = RelaxDepModNone -- ^ Default semantics
| RelaxDepModCaret -- ^ Apply relaxation only to @^>=@ constraints
deriving (Eq, Read, Show, Generic)
-- | Express whether to relax bounds /on/ @all@ packages, or a single package
data RelaxDepSubject = RelaxDepSubjectAll
| RelaxDepSubjectPkg !PackageName
deriving (Eq, Ord, Read, Show, Generic)
instance Text RelaxedDep where
disp (RelaxedDep scope rdmod dep) = case scope of
RelaxDepScopeAll -> modDep
disp (RelaxedDep scope rdmod subj) = case scope of
RelaxDepScopeAll -> Disp.text "all:" Disp.<> modDep
RelaxDepScopePackage p0 -> disp p0 Disp.<> Disp.colon Disp.<> modDep
RelaxDepScopePackageId p0 -> disp p0 Disp.<> Disp.colon Disp.<> modDep
where
modDep = case rdmod of
RelaxDepModNone -> disp dep
RelaxDepModCaret -> Disp.char '^' Disp.<> disp dep
RelaxDepModNone -> disp subj
RelaxDepModCaret -> Disp.char '^' Disp.<> disp subj
parse = RelaxedDep <$> scopeP <*> modP <*> parse
where
......@@ -454,9 +466,36 @@ instance Text RelaxedDep where
when (pkgVersion p0 == nullVersion) Parse.pfail
pure p0
instance Text RelaxDepSubject where
disp RelaxDepSubjectAll = Disp.text "all"
disp (RelaxDepSubjectPkg pn) = disp pn
parse = (pure RelaxDepSubjectAll <* Parse.char '*') Parse.<++ pkgn
where
pkgn = do
pn <- parse
pure (if (pn == mkPackageName "all")
then RelaxDepSubjectAll
else RelaxDepSubjectPkg pn)
instance Text RelaxDeps where
disp rd | not (isRelaxDeps rd) = Disp.text "none"
disp (RelaxDepsSome pkgs) = Disp.fsep .
Disp.punctuate Disp.comma .
map disp $ pkgs
disp RelaxDepsAll = Disp.text "all"
parse = (const mempty <$> ((Parse.string "none" Parse.+++
Parse.string "None") <* Parse.eof))
Parse.<++ (const RelaxDepsAll <$> ((Parse.string "all" Parse.+++
Parse.string "All" Parse.+++
Parse.string "*") <* Parse.eof))
Parse.<++ ( RelaxDepsSome <$> parseOptCommaList parse)
instance Binary RelaxDeps
instance Binary RelaxDepMod
instance Binary RelaxDepScope
instance Binary RelaxDepSubject
instance Binary RelaxedDep
instance Binary AllowNewer
instance Binary AllowOlder
......
......@@ -13,8 +13,8 @@
* Completed the 'new-bench' command. Same as above.
* '--allow-{newer,older}' syntax has been enhanced. Dependency
relaxation can be now limited to a specific release of a package,
plus there's a now syntax for relaxing only caret dependencies
(#4575).
plus there's a now syntax for relaxing only caret-style (i.e. '^>=')
dependencies (#4575, #4669).
2.0.0.0 Ryan Thomas <ryan@ryant.org> July 2017
* Removed the '--root-cmd' parameter of the 'install' command
......
......@@ -65,6 +65,8 @@ tests =
, testGroup "individual parser tests"
[ testProperty "package location" prop_parsePackageLocationTokenQ
, testProperty "RelaxedDep" prop_roundtrip_printparse_RelaxedDep
, testProperty "RelaxDeps" prop_roundtrip_printparse_RelaxDeps
, testProperty "RelaxDeps'" prop_roundtrip_printparse_RelaxDeps'
]
, testGroup "ProjectConfig printing/parsing round trip"
......@@ -234,19 +236,38 @@ prop_roundtrip_printparse_specific config =
-- Individual Parser tests
--
-- | Helper to parse a given string
--
-- Succeeds only if there is a unique complete parse
runReadP :: Parse.ReadP a a -> String -> Maybe a
runReadP parser s = case [ x | (x,"") <- Parse.readP_to_S parser s ] of
[x'] -> Just x'
_ -> Nothing
prop_parsePackageLocationTokenQ :: PackageLocationString -> Bool
prop_parsePackageLocationTokenQ (PackageLocationString str) =
case [ x | (x,"") <- Parse.readP_to_S parsePackageLocationTokenQ
(renderPackageLocationToken str) ] of
[str'] -> str' == str
_ -> False
runReadP parsePackageLocationTokenQ (renderPackageLocationToken str) == Just str
prop_roundtrip_printparse_RelaxedDep :: RelaxedDep -> Bool
prop_roundtrip_printparse_RelaxedDep rdep =
case [ x | (x,"") <- Parse.readP_to_S Text.parse (Text.display rdep) ] of
[rdep'] -> rdep' == rdep
_ -> False
runReadP Text.parse (Text.display rdep) == Just rdep
prop_roundtrip_printparse_RelaxDeps :: RelaxDeps -> Bool
prop_roundtrip_printparse_RelaxDeps rdep =
runReadP Text.parse (Text.display rdep) == Just rdep
prop_roundtrip_printparse_RelaxDeps' :: RelaxDeps -> Bool
prop_roundtrip_printparse_RelaxDeps' rdep =
runReadP Text.parse (go $ Text.display rdep) == Just rdep
where
-- replace 'all' tokens by '*'
go :: String -> String
go [] = []
go "all" = "*"
go ('a':'l':'l':c:rest) | c `elem` ":," = '*' : go (c:rest)
go rest = let (x,y) = break (`elem` ":,") rest
(x',y') = span (`elem` ":,^") y
in x++x'++go y'
------------------------
-- Arbitrary instances
......@@ -799,6 +820,11 @@ instance Arbitrary RelaxDepScope where
, RelaxDepScopePackageId <$> (PackageIdentifier <$> arbitrary <*> arbitrary)
]
instance Arbitrary RelaxDepSubject where
arbitrary = oneof [ pure RelaxDepSubjectAll
, RelaxDepSubjectPkg <$> arbitrary
]
instance Arbitrary RelaxedDep where
arbitrary = RelaxedDep <$> arbitrary <*> arbitrary <*> arbitrary
......
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