diff --git a/Cabal-syntax/src/Distribution/Types/VersionRange.hs b/Cabal-syntax/src/Distribution/Types/VersionRange.hs index c470b93c0d2..80b0373df9c 100644 --- a/Cabal-syntax/src/Distribution/Types/VersionRange.hs +++ b/Cabal-syntax/src/Distribution/Types/VersionRange.hs @@ -1,7 +1,27 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} + module Distribution.Types.VersionRange - ( -- * Version ranges + ( -- * Version Range VersionRange + -- ** Predicates + -- $predicate-examples + + -- *** Lower Bound + , hasLowerBound + , hasGTLowerBound + + -- *** Upper Bound + , hasUpperBound + , hasLEUpperBound + , hasTrailingZeroUpperBound + + -- *** Any Version + , isAnyVersion + , isAnyVersionLight + -- ** Constructing , anyVersion , noVersion @@ -16,32 +36,31 @@ module Distribution.Types.VersionRange , withinVersion , majorBoundVersion - -- ** Inspection + -- ** Modification + , normaliseVersionRange + , stripParensVersionRange - -- - -- See "Distribution.Version" for more utilities. + -- ** Inspection , withinRange , foldVersionRange - , normaliseVersionRange - , stripParensVersionRange - , hasUpperBound - , hasLowerBound - -- ** Cata & ana + -- ** Parser + , versionRangeParser + + -- * Version F-Algebra , VersionRangeF (..) + , projectVersionRange + , embedVersionRange , cataVersionRange , anaVersionRange , hyloVersionRange - , projectVersionRange - , embedVersionRange - -- ** Utilities - , isAnyVersion - , isAnyVersionLight + -- * Version Utilities + + -- See "Distribution.Version" for more utilities. , wildcardUpperBound , majorUpperBound , isWildcardRange - , versionRangeParser ) where import Distribution.Compat.Prelude @@ -172,6 +191,9 @@ isWildcardRange ver1 ver2 = check (versionNumbers ver1) (versionNumbers ver2) -- | Does the version range have an upper bound? -- -- @since 1.24.0.0 +-- +-- >>> forM ["< 1", ">= 0 && < 1", ">= 0 || < 1", "^>= 4.20.0.0"] (fmap hasUpperBound . simpleParsec) +-- Just [True,True,False,True] hasUpperBound :: VersionRange -> Bool hasUpperBound = foldVersionRange @@ -188,6 +210,9 @@ hasUpperBound = -- the implicit >=0 lower bound. -- -- @since 1.24.0.0 +-- +-- >>> forM ["< 1", ">= 0 && < 1", ">= 0 || < 1", "^>= 4.20.0.0"] (fmap hasLowerBound . simpleParsec) +-- Just [False,True,False,True] hasLowerBound :: VersionRange -> Bool hasLowerBound = foldVersionRange @@ -197,3 +222,50 @@ hasLowerBound = (const False) (&&) (||) + +-- | Is the upper bound version range (less than or equal (LE, <=)? +-- +-- >>> forM ["< 1", "<= 1", ">= 0 && < 1", ">= 0 || < 1", ">= 0 && <= 1", ">= 0 || <= 1", "^>= 4.20.0.0"] (fmap hasLEUpperBound . simpleParsec) +-- Just [False,True,False,False,True,True,False] +hasLEUpperBound :: VersionRange -> Bool +hasLEUpperBound = queryVersionRange (\case LEUpperBound -> True; _ -> False) hasLEUpperBound + +-- | Is the lower bound version range greater than (GT, >)? +-- +-- >>> forM ["< 1", ">= 0 && < 1", ">= 0 || < 1", "> 0 && < 1", "> 0 || < 1", "^>= 4.20.0.0"] (fmap hasGTLowerBound . simpleParsec) +-- Just [False,False,False,True,True,False] +hasGTLowerBound :: VersionRange -> Bool +hasGTLowerBound = queryVersionRange (\case GTLowerBound -> True; _ -> False) hasGTLowerBound + +-- | Does the upper bound version range have a trailing zero? +-- +-- >>> forM ["< 1", "< 1.1", "< 1.0", "< 1.1.0", "^>= 4.20.0.0"] (fmap hasTrailingZeroUpperBound . simpleParsec) +-- Just [False,False,True,True,False] +hasTrailingZeroUpperBound :: VersionRange -> Bool +hasTrailingZeroUpperBound = queryVersionRange (\case TZUpperBound -> True; _ -> False) hasTrailingZeroUpperBound + +queryVersionRange :: (VersionRangeF VersionRange -> Bool) -> (VersionRange -> Bool) -> VersionRange -> Bool +queryVersionRange pf p (projectVersionRange -> v) = + let f = queryVersionRange pf p + in pf v || case v of + IntersectVersionRangesF x y -> f x || f y + UnionVersionRangesF x y -> f x || f y + _ -> False + +-- $setup +-- >>> import Distribution.Parsec +-- >>> import Data.Traversable + +-- $predicate-examples +-- +-- The parsed 'VersionRange' of each version constraint used in the examples for +-- 'hasUpperBound' and 'hasLowerBound' are: +-- +-- >>> simpleParsec "< 1" :: Maybe VersionRange +-- Just (EarlierVersion (mkVersion [1])) +-- >>> simpleParsec ">= 0 && < 1" :: Maybe VersionRange +-- Just (IntersectVersionRanges (OrLaterVersion (mkVersion [0])) (EarlierVersion (mkVersion [1]))) +-- >>> simpleParsec ">= 0 || < 1" :: Maybe VersionRange +-- Just (UnionVersionRanges (OrLaterVersion (mkVersion [0])) (EarlierVersion (mkVersion [1]))) +-- >>> simpleParsec "^>= 4.20.0.0" :: Maybe VersionRange +-- Just (MajorBoundVersion (mkVersion [4,20,0,0])) diff --git a/Cabal-syntax/src/Distribution/Types/VersionRange/Internal.hs b/Cabal-syntax/src/Distribution/Types/VersionRange/Internal.hs index ef82ae86045..8669bf8f072 100644 --- a/Cabal-syntax/src/Distribution/Types/VersionRange/Internal.hs +++ b/Cabal-syntax/src/Distribution/Types/VersionRange/Internal.hs @@ -3,7 +3,9 @@ {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} -- | The only purpose of this module is to prevent the export of -- 'VersionRange' constructors from @@ -23,7 +25,7 @@ module Distribution.Types.VersionRange.Internal , intersectVersionRanges , withinVersion , majorBoundVersion - , VersionRangeF (..) + , VersionRangeF (.., LEUpperBound, GTLowerBound, TZUpperBound) , projectVersionRange , embedVersionRange , cataVersionRange @@ -185,6 +187,22 @@ data VersionRangeF a , Traversable ) +pattern LEUpperBound, GTLowerBound, TZUpperBound :: VersionRangeF a +pattern LEUpperBound <- OrEarlierVersionF _ +pattern GTLowerBound <- LaterVersionF _ +pattern TZUpperBound <- (upperTrailingZero -> True) + +upperTrailingZero :: VersionRangeF a -> Bool +upperTrailingZero (OrEarlierVersionF x) = trailingZero x +upperTrailingZero (EarlierVersionF x) = trailingZero x +upperTrailingZero _ = False + +trailingZero :: Version -> Bool +trailingZero (versionNumbers -> vs) + | [0] <- vs = False + | 0 : _ <- reverse vs = True + | otherwise = False + -- | Generic destructor for 'VersionRange'. -- -- @since 2.2 diff --git a/Cabal-syntax/src/Distribution/Version.hs b/Cabal-syntax/src/Distribution/Version.hs index 80383358037..76aed461228 100644 --- a/Cabal-syntax/src/Distribution/Version.hs +++ b/Cabal-syntax/src/Distribution/Version.hs @@ -50,6 +50,9 @@ module Distribution.Version , stripParensVersionRange , hasUpperBound , hasLowerBound + , hasLEUpperBound + , hasTrailingZeroUpperBound + , hasGTLowerBound -- ** Cata & ana , VersionRangeF (..) diff --git a/Cabal-tests/tests/ParserTests/regressions/issue-8646.cabal b/Cabal-tests/tests/ParserTests/regressions/issue-8646.cabal index d631357925f..c7576037132 100644 --- a/Cabal-tests/tests/ParserTests/regressions/issue-8646.cabal +++ b/Cabal-tests/tests/ParserTests/regressions/issue-8646.cabal @@ -11,6 +11,6 @@ license: BSD-3-Clause executable test main-is: ExeMain.hs - build-depends: base > 4 && < 5 + build-depends: base >= 4 && < 5 default-language: Haskell2010 ghc-options: -main-is ExeMain diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index 8bab6ec961a..2d9750de77d 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -568,8 +568,20 @@ checkSetupBuildInfo (Just (SetupBuildInfo ds _)) = do rck = PackageDistSuspiciousWarn . MissingUpperBounds CETSetup - checkPVP ick is - checkPVPs rck rs + leuck = + PackageDistSuspiciousWarn + . LEUpperBounds CETSetup + tzuck = + PackageDistSuspiciousWarn + . TrailingZeroUpperBounds CETSetup + gtlck = + PackageDistSuspiciousWarn + . GTLowerBounds CETSetup + checkPVP (checkDependencyVersionRange $ not . hasUpperBound) ick is + checkPVPs (checkDependencyVersionRange $ not . hasUpperBound) rck rs + checkPVPs (checkDependencyVersionRange hasLEUpperBound) leuck ds + checkPVPs (checkDependencyVersionRange hasTrailingZeroUpperBound) tzuck ds + checkPVPs (checkDependencyVersionRange hasGTLowerBound) gtlck ds checkPackageId :: Monad m => PackageIdentifier -> CheckM m () checkPackageId (PackageIdentifier pkgName_ _pkgVersion_) = do diff --git a/Cabal/src/Distribution/PackageDescription/Check/Common.hs b/Cabal/src/Distribution/PackageDescription/Check/Common.hs index 5bdf5c33fe7..87ad55d7ade 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Common.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Common.hs @@ -16,6 +16,7 @@ module Distribution.PackageDescription.Check.Common , partitionDeps , checkPVP , checkPVPs + , checkDependencyVersionRange ) where import Distribution.Compat.Prelude @@ -116,34 +117,32 @@ partitionDeps ads ns ds = do -- for important dependencies like base). checkPVP :: Monad m - => (String -> PackageCheck) -- Warn message depends on name + => (Dependency -> Bool) + -> (String -> PackageCheck) -- Warn message depends on name -- (e.g. "base", "Cabal"). -> [Dependency] -> CheckM m () -checkPVP ckf ds = do - let ods = checkPVPPrim ds +checkPVP p ckf ds = do + let ods = filter p ds mapM_ (tellP . ckf . unPackageName . depPkgName) ods -- PVP dependency check for a list of dependencies. Some code duplication -- is sadly needed to provide more ergonimic error messages. checkPVPs :: Monad m - => ( [String] + => (Dependency -> Bool) + -> ( [String] -> PackageCheck -- Grouped error message, depends on a -- set of names. ) -> [Dependency] -- Deps to analyse. -> CheckM m () -checkPVPs cf ds +checkPVPs p cf ds | null ns = return () | otherwise = tellP (cf ns) where - ods = checkPVPPrim ds + ods = filter p ds ns = map (unPackageName . depPkgName) ods --- Returns dependencies without upper bounds. -checkPVPPrim :: [Dependency] -> [Dependency] -checkPVPPrim ds = filter withoutUpper ds - where - withoutUpper :: Dependency -> Bool - withoutUpper (Dependency _ ver _) = not . hasUpperBound $ ver +checkDependencyVersionRange :: (VersionRange -> Bool) -> Dependency -> Bool +checkDependencyVersionRange p (Dependency _ ver _) = p ver diff --git a/Cabal/src/Distribution/PackageDescription/Check/Target.hs b/Cabal/src/Distribution/PackageDescription/Check/Target.hs index c40fc0ef09a..0bf173cb980 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Target.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Target.hs @@ -331,17 +331,30 @@ checkBuildInfo cet ams ads bi = do checkAutogenModules ams bi -- PVP: we check for base and all other deps. + let ds = mergeDependencies $ targetBuildDepends bi (ids, rds) <- partitionDeps ads [mkUnqualComponentName "base"] - (mergeDependencies $ targetBuildDepends bi) + ds let ick = const (PackageDistInexcusable BaseNoUpperBounds) rck = PackageDistSuspiciousWarn . MissingUpperBounds cet - checkPVP ick ids + leuck = PackageDistSuspiciousWarn . LEUpperBounds cet + tzuck = PackageDistSuspiciousWarn . TrailingZeroUpperBounds cet + gtlck = PackageDistSuspiciousWarn . GTLowerBounds cet + checkPVP (checkDependencyVersionRange $ not . hasUpperBound) ick ids unless (isInternalTarget cet) - (checkPVPs rck rds) + (checkPVPs (checkDependencyVersionRange $ not . hasUpperBound) rck rds) + unless + (isInternalTarget cet) + (checkPVPs (checkDependencyVersionRange hasLEUpperBound) leuck ds) + unless + (isInternalTarget cet) + (checkPVPs (checkDependencyVersionRange hasTrailingZeroUpperBound) tzuck ds) + unless + (isInternalTarget cet) + (checkPVPs (checkDependencyVersionRange hasGTLowerBound) gtlck ds) -- Custom fields well-formedness (ASCII). mapM_ checkCustomField (customFieldsBI bi) diff --git a/Cabal/src/Distribution/PackageDescription/Check/Warning.hs b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs index 8f388635342..54e0a2687ca 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Warning.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs @@ -255,6 +255,9 @@ data CheckExplanation | UnknownCompiler [String] | BaseNoUpperBounds | MissingUpperBounds CEType [String] + | LEUpperBounds CEType [String] + | TrailingZeroUpperBounds CEType [String] + | GTLowerBounds CEType [String] | SuspiciousFlagName [String] | DeclaredUsedFlags (Set.Set FlagName) (Set.Set FlagName) | NonASCIICustomField [String] @@ -418,6 +421,9 @@ data CheckExplanationID | CIUnknownCompiler | CIBaseNoUpperBounds | CIMissingUpperBounds + | CILEUpperBounds + | CITrailingZeroUpperBounds + | CIGTLowerBounds | CISuspiciousFlagName | CIDeclaredUsedFlags | CINonASCIICustomField @@ -560,6 +566,9 @@ checkExplanationId (UnknownArch{}) = CIUnknownArch checkExplanationId (UnknownCompiler{}) = CIUnknownCompiler checkExplanationId (BaseNoUpperBounds{}) = CIBaseNoUpperBounds checkExplanationId (MissingUpperBounds{}) = CIMissingUpperBounds +checkExplanationId (LEUpperBounds{}) = CILEUpperBounds +checkExplanationId (TrailingZeroUpperBounds{}) = CITrailingZeroUpperBounds +checkExplanationId (GTLowerBounds{}) = CIGTLowerBounds checkExplanationId (SuspiciousFlagName{}) = CISuspiciousFlagName checkExplanationId (DeclaredUsedFlags{}) = CIDeclaredUsedFlags checkExplanationId (NonASCIICustomField{}) = CINonASCIICustomField @@ -707,6 +716,12 @@ ppCheckExplanationId CIUnknownArch = "unknown-arch" ppCheckExplanationId CIUnknownCompiler = "unknown-compiler" ppCheckExplanationId CIBaseNoUpperBounds = "missing-bounds-important" ppCheckExplanationId CIMissingUpperBounds = "missing-upper-bounds" +-- NOTE: Satisfy the Parsimonious test, a test that checks that these messages +-- don't have too many dashes: +-- $ cabal run Cabal-tests:unit-tests -- --pattern=Parsimonious +ppCheckExplanationId CILEUpperBounds = "le-upper-bounds" +ppCheckExplanationId CITrailingZeroUpperBounds = "tz-upper-bounds" +ppCheckExplanationId CIGTLowerBounds = "gt-lower-bounds" ppCheckExplanationId CISuspiciousFlagName = "suspicious-flag" ppCheckExplanationId CIDeclaredUsedFlags = "unused-flag" ppCheckExplanationId CINonASCIICustomField = "non-ascii" @@ -1300,15 +1315,33 @@ ppExplanation BaseNoUpperBounds = ++ "version. For example if you have tested your package with 'base' " ++ "version 4.5 and 4.6 then use 'build-depends: base >= 4.5 && < 4.7'." ppExplanation (MissingUpperBounds ct names) = - let separator = "\n - " - in "On " - ++ ppCET ct - ++ ", " - ++ "these packages miss upper bounds:" - ++ separator - ++ List.intercalate separator names - ++ "\n" - ++ "Please add them. There is more information at https://pvp.haskell.org/" + "On " + ++ ppCET ct + ++ ", " + ++ "these packages miss upper bounds:" + ++ listSep names + ++ "Please add them. There is more information at https://pvp.haskell.org/" +ppExplanation (LEUpperBounds ct names) = + "On " + ++ ppCET ct + ++ ", " + ++ "these packages have less than or equals (<=) upper bounds:" + ++ listSep names + ++ "Please use less than (<) for upper bounds." +ppExplanation (TrailingZeroUpperBounds ct names) = + "On " + ++ ppCET ct + ++ ", " + ++ "these packages have upper bounds with trailing zeros:" + ++ listSep names + ++ "Please avoid trailing zeros for upper bounds." +ppExplanation (GTLowerBounds ct names) = + "On " + ++ ppCET ct + ++ ", " + ++ "these packages have greater than (>) lower bounds:" + ++ listSep names + ++ "Please use greater than or equals (>=) for lower bounds." ppExplanation (SuspiciousFlagName invalidFlagNames) = "Suspicious flag names: " ++ unwords invalidFlagNames @@ -1470,6 +1503,11 @@ ppExplanation (WrongFieldForExpectedDocFiles extraDocFileSupport field paths) = -- * Formatting utilities +listSep :: [String] -> String +listSep names = + let separator = "\n - " + in separator ++ List.intercalate separator names ++ "\n" + commaSep :: [String] -> String commaSep = List.intercalate ", " diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Fields/ImpossibleVersionRangeLib/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Fields/ImpossibleVersionRangeLib/cabal.out index c037b09c0f5..833cb9c0fe9 100644 --- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Fields/ImpossibleVersionRangeLib/cabal.out +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Fields/ImpossibleVersionRangeLib/cabal.out @@ -1,4 +1,11 @@ # cabal check The package will not build sanely due to these errors: Error: [impossible-dep] The package has an impossible version range for a dependency on an internal library: pkg:internal >1.0 && <2.0. This version range does not include the current package, and must be removed as the current package's library will always be used. +These warnings may cause trouble when distributing the package: +Warning: [tz-upper-bounds] On library, these packages have upper bounds with trailing zeros: + - pkg +Please avoid trailing zeros for upper bounds. +Warning: [gt-lower-bounds] On library, these packages have greater than (>) lower bounds: + - pkg +Please use greater than or equals (>=) for lower bounds. Error: Hackage would reject this package. diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.out index 37aa169b416..52680032f6d 100644 --- a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.out +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternal/cabal.out @@ -1,2 +1,5 @@ # cabal check -No errors or warnings could be found in the package. +These warnings may cause trouble when distributing the package: +Warning: [le-upper-bounds] On library, these packages have less than or equals (<=) upper bounds: + - base +Please use less than (<) for upper bounds. diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.out index 2c1d8a72480..7ba9b6f27d4 100644 --- a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.out +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsInternalSimple/cabal.out @@ -3,3 +3,6 @@ These warnings may cause trouble when distributing the package: Warning: [missing-upper-bounds] On executable 'prova', these packages miss upper bounds: - acme-box Please add them. There is more information at https://pvp.haskell.org/ +Warning: [tz-upper-bounds] On library, these packages have upper bounds with trailing zeros: + - text +Please avoid trailing zeros for upper bounds. diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.out index c9f531cbd6e..603ff161043 100644 --- a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.out +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsLibInt/cabal.out @@ -3,3 +3,9 @@ These warnings may cause trouble when distributing the package: Warning: [missing-upper-bounds] On library 'int-lib', these packages miss upper bounds: - text Please add them. There is more information at https://pvp.haskell.org/ +Warning: [le-upper-bounds] On library, these packages have less than or equals (<=) upper bounds: + - base +Please use less than (<) for upper bounds. +Warning: [gt-lower-bounds] On library 'int-lib', these packages have greater than (>) lower bounds: + - text +Please use greater than or equals (>=) for lower bounds. diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/cabal.out index 37aa169b416..a8e84640cdb 100644 --- a/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/cabal.out +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/PackageVersionsStraddle/cabal.out @@ -1,2 +1,8 @@ # cabal check -No errors or warnings could be found in the package. +These warnings may cause trouble when distributing the package: +Warning: [le-upper-bounds] On library, these packages have less than or equals (<=) upper bounds: + - base +Please use less than (<) for upper bounds. +Warning: [gt-lower-bounds] On library, these packages have greater than (>) lower bounds: + - base +Please use greater than or equals (>=) for lower bounds. diff --git a/cabal-testsuite/PackageTests/Check/NonConfCheck/SetupBounds/cabal.out b/cabal-testsuite/PackageTests/Check/NonConfCheck/SetupBounds/cabal.out index 895d3a63943..59e0cefd25c 100644 --- a/cabal-testsuite/PackageTests/Check/NonConfCheck/SetupBounds/cabal.out +++ b/cabal-testsuite/PackageTests/Check/NonConfCheck/SetupBounds/cabal.out @@ -1,4 +1,8 @@ # cabal check +These warnings may cause trouble when distributing the package: +Warning: [gt-lower-bounds] On custom-setup, these packages have greater than (>) lower bounds: + - base +Please use greater than or equals (>=) for lower bounds. The following errors will cause portability problems on other environments: Error: [missing-bounds-setup] The dependency 'setup-depends: 'base' does not specify an upper bound on the version number. Each major release of the 'base' package changes the API in various ways and most packages will need some changes to compile with it. If you are not sure what upper bound to use then use the next major version. Error: Hackage would reject this package. diff --git a/cabal-testsuite/PackageTests/Check/PackageFiles/VersionBounds/cabal.out b/cabal-testsuite/PackageTests/Check/PackageFiles/VersionBounds/cabal.out new file mode 100644 index 00000000000..6368896bc4c --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/PackageFiles/VersionBounds/cabal.out @@ -0,0 +1,18 @@ +# cabal check +These warnings may cause trouble when distributing the package: +Warning: [missing-upper-bounds] On library, these packages miss upper bounds: + - missing-upper + - exclusive-minimums-missing-upper + - or-exclusive-minimums-missing-upper + - or-inclusive-maximums-missing-upper +Please add them. There is more information at https://pvp.haskell.org/ +Warning: [le-upper-bounds] On library, these packages have less than or equals (<=) upper bounds: + - inclusive-maximums + - and-inclusive-maximums + - or-inclusive-maximums-missing-upper +Please use less than (<) for upper bounds. +Warning: [gt-lower-bounds] On library, these packages have greater than (>) lower bounds: + - exclusive-minimums-missing-upper + - and-exclusive-minimums + - or-exclusive-minimums-missing-upper +Please use greater than or equals (>=) for lower bounds. diff --git a/cabal-testsuite/PackageTests/Check/PackageFiles/VersionBounds/cabal.test.hs b/cabal-testsuite/PackageTests/Check/PackageFiles/VersionBounds/cabal.test.hs new file mode 100644 index 00000000000..60a32cb7374 --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/PackageFiles/VersionBounds/cabal.test.hs @@ -0,0 +1,4 @@ +import Test.Cabal.Prelude + +main = cabalTest $ + cabal "check" [] diff --git a/cabal-testsuite/PackageTests/Check/PackageFiles/VersionBounds/pkg.cabal b/cabal-testsuite/PackageTests/Check/PackageFiles/VersionBounds/pkg.cabal new file mode 100644 index 00000000000..f8fc673e14c --- /dev/null +++ b/cabal-testsuite/PackageTests/Check/PackageFiles/VersionBounds/pkg.cabal @@ -0,0 +1,25 @@ +cabal-version: 3.0 +name: pkg +synopsis: synopsis +description: description +version: 0 +category: example +maintainer: none@example.com +license: GPL-3.0-or-later + +library + exposed-modules: Foo + default-language: Haskell2010 + build-depends: + , base ^>= 4.20.0.0 + + , missing-upper >= 0 + , missing-lower < 1 + + , exclusive-minimums-missing-upper > 0 + , and-exclusive-minimums > 0 && < 1 + , or-exclusive-minimums-missing-upper > 0 || < 1 + + , inclusive-maximums <= 1 + , and-inclusive-maximums >= 0 && <= 1 + , or-inclusive-maximums-missing-upper >= 0 || <= 1 diff --git a/changelog.d/pr-10554 b/changelog.d/pr-10554 new file mode 100644 index 00000000000..569bba5e0d8 --- /dev/null +++ b/changelog.d/pr-10554 @@ -0,0 +1,12 @@ +--- +synopsis: Adds more version range checks to `cabal check`. +packages: [Cabal-syntax, Cabal] +prs: 10554 +issues: 9806 +--- + +For dependencies, warns about and checks that version range bounds for: + +- lower bounds are inclusive, don't use (>) +- upper bounds are exclusive, don't use (<=) +- upper bounds don't have trailing zeros, don't end with (*.0). diff --git a/doc/cabal-commands.rst b/doc/cabal-commands.rst index ed088d14b8d..7fde877ce5c 100644 --- a/doc/cabal-commands.rst +++ b/doc/cabal-commands.rst @@ -1390,7 +1390,10 @@ A list of all warnings with their constructor: - ``unknown-arch``: unknown architecture in condition. - ``unknown-compiler``: unknown compiler in condition. - ``missing-bounds-important``: missing upper bounds for important dependencies (``base``, and for ``custom-setup`` ``Cabal`` too). -- ``missing-upper-bounds``: missing upper bound in dependency (excluding test-suites and benchmarks). +- ``missing-upper-bounds``: missing upper bound in dependency [#dep-excl]_. +- ``le-upper-bounds``: less than or equals (<=) constraint on upper bound in dependency [#dep-excl]_. +- ``tz-upper-bounds``: trailing zero (\*.0) upper bound in dependency [#dep-excl]_. +- ``gt-lower-bounds``: greater than (>) constraint on lower bound in dependency [#dep-excl]_. - ``suspicious-flag``: troublesome flag name (e.g. starting with a dash). - ``unused-flag``: unused user flags. - ``non-ascii``: non-ASCII characters in custom field. @@ -1419,6 +1422,36 @@ A list of all warnings with their constructor: file is not present in the :pkg-field:`extra-doc-files` field, warns about it. - ``doc-place``: documentation files listed in ``extra-source-files`` instead of ``extra-doc-files``. +.. [#dep-excl] In dependencies excluding test-suites and benchmarks. + +.. note:: + + ``cabal check`` warns on subexpressions (individual version constraints) of + a version range that are of the form, ``> version``, ``<= version``, ``<= + version.0[...0]``. These are considered suspicious because they are likely + to be mistakes. Guidelines for individual version constraints within + version ranges and examples of mistakes when not following these are: + + "A lower bound should be inclusive." + + Asking for ``base > 4.11`` when you actually want ``base >= 4.12`` is an + example of making this mistake. Versions make a dense space, so there + are infinitely many versions that are ``> 4.11`` and ``< 4.12``. + + "An upper bound should be exclusive." + + Asking for ``base <= 4.19.1.0`` when the last published version is + ``base-4.19.1.0`` is an example of making this mistake. This blocks + patch releases that should always be fine according to the PVP. The + correct minor bound is ``base < 4.19.2``. + + "An upper bound should not have trailing zeros." + + Asking for ``base < 4.20.0.0`` when you meant allow any ``base-4.19.*`` + version is an example of making this mistake. In fact, ``base-4.20`` and + ``base-4.20.0`` are not excluded by the bound. The correct bound is ``< + 4.20``. + .. _cabal-sdist: cabal sdist