From 826335bb279a5abad0534ff0542116565c0b65d6 Mon Sep 17 00:00:00 2001 From: Jappie Klooster Date: Wed, 3 Aug 2022 18:30:20 +0200 Subject: [PATCH] Add check for upper bound on any package fixes https://github.com/haskell/cabal/issues/8291 presumably this will make it nag at anyone for forgetting to add upper bounds to their packages. add changelog (presumably) wait what? move toDependencyVersionsMap to utils section add nicer error message simplify checking logic, add more comments only emit missing upper bounds if bigger then one don't add bound to internal libraries filter out self from the dependency map I think this is an external library so it needs an upper bound now? add test for multilib fix test suite by ignoring the warning ... probably not the best approach change link to pvp instead of parsonsmatt better wording on missing upper bound error remove spurious parenthesis change map creation from monad to list comprehension use foldmap to get rid of maybe, fix compile error rewrite from do notation to list comprehension fix test suite failing --- Cabal-tests/tests/CheckTests.hs | 1 + .../regressions/public-multilib-2.cabal | 2 +- .../regressions/public-multilib-3.cabal | 14 ++++ .../regressions/public-multilib-3.check | 3 + .../Distribution/PackageDescription/Check.hs | 69 +++++++++++-------- .../Distribution/Solver/Modular/DSL.hs | 6 +- changelog.d/pr-8339 | 4 ++ 7 files changed, 67 insertions(+), 32 deletions(-) create mode 100644 Cabal-tests/tests/ParserTests/regressions/public-multilib-3.cabal create mode 100644 Cabal-tests/tests/ParserTests/regressions/public-multilib-3.check create mode 100644 changelog.d/pr-8339 diff --git a/Cabal-tests/tests/CheckTests.hs b/Cabal-tests/tests/CheckTests.hs index b9b5d6d94f2..01370fc2395 100644 --- a/Cabal-tests/tests/CheckTests.hs +++ b/Cabal-tests/tests/CheckTests.hs @@ -45,6 +45,7 @@ checkTests = testGroup "regressions" , checkTest "assoc-cpp-options.cabal" , checkTest "public-multilib-1.cabal" , checkTest "public-multilib-2.cabal" + , checkTest "public-multilib-3.cabal" , checkTest "issue-6288-a.cabal" , checkTest "issue-6288-b.cabal" , checkTest "issue-6288-c.cabal" diff --git a/Cabal-tests/tests/ParserTests/regressions/public-multilib-2.cabal b/Cabal-tests/tests/ParserTests/regressions/public-multilib-2.cabal index fe0d60a561c..13d6c72f2de 100644 --- a/Cabal-tests/tests/ParserTests/regressions/public-multilib-2.cabal +++ b/Cabal-tests/tests/ParserTests/regressions/public-multilib-2.cabal @@ -9,6 +9,6 @@ library default-language: Haskell2010 build-depends: , base ^>=4.14 - , somelib:internal + , somelib:internal ^>=1.0 exposed-modules: Foo diff --git a/Cabal-tests/tests/ParserTests/regressions/public-multilib-3.cabal b/Cabal-tests/tests/ParserTests/regressions/public-multilib-3.cabal new file mode 100644 index 00000000000..cde78b61b52 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/regressions/public-multilib-3.cabal @@ -0,0 +1,14 @@ +cabal-version: 3.0 +name: public-multilib3 +version: 0 +synopsis: public-multilibs +category: Tests +license: MIT + +library + default-language: Haskell2010 + build-depends: + , base ^>=4.14 + , somelib + + exposed-modules: Foo diff --git a/Cabal-tests/tests/ParserTests/regressions/public-multilib-3.check b/Cabal-tests/tests/ParserTests/regressions/public-multilib-3.check new file mode 100644 index 00000000000..aa1d95e299c --- /dev/null +++ b/Cabal-tests/tests/ParserTests/regressions/public-multilib-3.check @@ -0,0 +1,3 @@ +No 'maintainer' field. +No 'description' field. +These packages miss upper bounds 'somelib' please add them using `cabal gen-bounds` for suggestions. For more information see: https://pvp.haskell.org/ diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index 198ee83658a..7e18c307f5c 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -227,6 +227,7 @@ data CheckExplanation = | UnknownArch [String] | UnknownCompiler [String] | BaseNoUpperBounds + | MissingUpperBounds [PackageName] | SuspiciousFlagName [String] | DeclaredUsedFlags (Set FlagName) (Set FlagName) | NonASCIICustomField [String] @@ -669,6 +670,12 @@ ppExplanation (UnknownArch unknownArches) = "Unknown architecture name " ++ commaSep (map quote unknownArches) ppExplanation (UnknownCompiler unknownImpls) = "Unknown compiler name " ++ commaSep (map quote unknownImpls) +ppExplanation (MissingUpperBounds names) = + "These packages miss upper bounds '" + ++ (intercalate "','" (unPackageName <$> names)) ++ "'" + ++ " please add them using `cabal gen-bounds` for suggestions." + ++ " For more information see: " + ++ " https://pvp.haskell.org/" ppExplanation BaseNoUpperBounds = "The dependency 'build-depends: base' does not specify an upper " ++ "bound on the version number. Each major release of the 'base' " @@ -1814,29 +1821,20 @@ checkCabalVersion pkg = -- checkPackageVersions :: GenericPackageDescription -> [PackageCheck] checkPackageVersions pkg = - catMaybes [ - - -- Check that the version of base is bounded above. - -- For example this bans "build-depends: base >= 3". - -- It should probably be "build-depends: base >= 3 && < 4" - -- which is the same as "build-depends: base == 3.*" - check (not (hasUpperBound baseDependency)) $ - PackageDistInexcusable BaseNoUpperBounds - - ] + if length others > 0 + then + PackageDistSuspiciousWarn (MissingUpperBounds others) : baseErrors + else + baseErrors where - baseDependency = case typicalPkg pkg of - Right (pkg', _) | not (null baseDeps) -> - foldr intersectVersionRanges anyVersion baseDeps - where - baseDeps = - [ vr | Dependency pname vr _ <- allBuildDepends pkg' - , pname == mkPackageName "base" ] - - -- Just in case finalizePD fails for any reason, - -- or if the package doesn't depend on the base package at all, - -- then we will just skip the check, since hasUpperBound noVersion = True - _ -> noVersion + baseErrors = PackageDistInexcusable BaseNoUpperBounds <$ bases + deps = toDependencyVersionsMap allBuildDepends pkg + -- base gets special treatment (it's more critical) + (bases, others) = partition (("base" ==) . unPackageName) $ + [ name + | (name, vr) <- Map.toList deps + , not hasUpperBound vr + ] checkConditionals :: GenericPackageDescription -> [PackageCheck] checkConditionals pkg = @@ -2410,14 +2408,7 @@ checkSetupVersions pkg = ] where criticalPkgs = ["Cabal", "base"] - deps = case typicalPkg pkg of - Right (pkgs', _) -> - Map.fromListWith intersectVersionRanges - [ (pname, vr) - | sbi <- maybeToList $ setupBuildInfo pkgs' - , Dependency pname vr _ <- setupDepends sbi - ] - _ -> Map.empty + deps = toDependencyVersionsMap (foldMap setupDepends . setupBuildInfo) pkg emitError nm = PackageDistInexcusable (UpperBoundSetup nm) @@ -2456,6 +2447,24 @@ checkDuplicateModules pkg = -- * Utils -- ------------------------------------------------------------ +toDependencyVersionsMap :: (PackageDescription -> [Dependency]) -> GenericPackageDescription -> Map PackageName VersionRange +toDependencyVersionsMap selectDependencies pkg = case typicalPkg pkg of + Right (pkgs', _) -> + let + self :: PackageName + self = pkgName $ package pkgs' + in + Map.fromListWith intersectVersionRanges $ + [ (pname, vr) + | Dependency pname vr _ <- selectDependencies pkgs' + , pname /= self + ] + -- Just in case finalizePD fails for any reason, + -- or if the package doesn't depend on the base package at all, + -- no deps is no checks. + _ -> Map.empty + + quote :: String -> String quote s = "'" ++ s ++ "'" diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs index 157f5c3cc2f..e29e3223f3f 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs @@ -478,7 +478,7 @@ exAvSrcPkg ex = -- solver allows unknown extensions/languages when the compiler -- supports them. let checks = C.checkPackage (srcpkgDescription package) Nothing - in filter (not . isUnknownLangExt) checks + in filter (not . isMissingUpperBound) $ filter (not . isUnknownLangExt) checks in if null pkgCheckErrors then package else error $ "invalid GenericPackageDescription for package " @@ -671,6 +671,10 @@ exAvSrcPkg ex = C.UnknownExtensions {} -> True C.UnknownLanguages {} -> True _ -> False + isMissingUpperBound :: C.PackageCheck -> Bool + isMissingUpperBound pc = case C.explanation pc of + C.MissingUpperBounds {} -> True + _ -> False mkSimpleVersion :: ExamplePkgVersion -> C.Version diff --git a/changelog.d/pr-8339 b/changelog.d/pr-8339 new file mode 100644 index 00000000000..1e602c1e985 --- /dev/null +++ b/changelog.d/pr-8339 @@ -0,0 +1,4 @@ +synopsis: Add check for upper bound on any dependency in cabal check +report, list, init, fetch, info, upload, get. +prs: #8339 +issues: #8291