Add check for upper bound on any package

fixes haskell#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

fix compile error

factor out double filter call in a && expression

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"

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

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

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/

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]
@@ -666,6 +667,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' "
@@ -1813,29 +1820,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 =
@@ -2409,14 +2407,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)
 
@@ -2455,6 +2446,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 ++ "'"
 

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 (\x -> not (isMissingUpperBound x) && not (isUnknownLangExt x)) 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

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