Skip to content

Commit

Permalink
Drop Has prefix on patterns, use LE not LEQ
Browse files Browse the repository at this point in the history
- avoid name clash with has*Bound (VersionRange -> Bool) predicates
- use TZ not TrailingZero, a two-letter prefix like the other two
  • Loading branch information
philderbeast committed Dec 1, 2024
1 parent 14e85f9 commit 4b2559c
Show file tree
Hide file tree
Showing 6 changed files with 22 additions and 22 deletions.
12 changes: 6 additions & 6 deletions Cabal-syntax/src/Distribution/Types/VersionRange.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@ module Distribution.Types.VersionRange

-- *** Upper Bound
, hasUpperBound
, hasLEQUpperBound
, hasLEUpperBound
, hasTrailingZeroUpperBound

-- *** Any Version
Expand Down Expand Up @@ -225,24 +225,24 @@ hasLowerBound =

-- | 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 hasLEQUpperBound . simpleParsec)
-- >>> 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]
hasLEQUpperBound :: VersionRange -> Bool
hasLEQUpperBound = queryVersionRange (\case HasLEQUpperBound -> True; _ -> False) hasLEQUpperBound
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 HasGTLowerBound -> True; _ -> False) hasGTLowerBound
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 HasTrailingZeroUpperBound -> True; _ -> False) hasTrailingZeroUpperBound
hasTrailingZeroUpperBound = queryVersionRange (\case TZUpperBound -> True; _ -> False) hasTrailingZeroUpperBound

queryVersionRange :: (VersionRangeF VersionRange -> Bool) -> (VersionRange -> Bool) -> VersionRange -> Bool
queryVersionRange pf p (projectVersionRange -> v) =
Expand Down
10 changes: 5 additions & 5 deletions Cabal-syntax/src/Distribution/Types/VersionRange/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,7 @@ module Distribution.Types.VersionRange.Internal
, intersectVersionRanges
, withinVersion
, majorBoundVersion
, VersionRangeF (.., HasLEQUpperBound, HasGTLowerBound, HasTrailingZeroUpperBound)
, VersionRangeF (.., LEUpperBound, GTLowerBound, TZUpperBound)
, projectVersionRange
, embedVersionRange
, cataVersionRange
Expand Down Expand Up @@ -189,10 +189,10 @@ data VersionRangeF a
, Traversable
)

pattern HasLEQUpperBound, HasGTLowerBound, HasTrailingZeroUpperBound :: VersionRangeF a
pattern HasLEQUpperBound <- OrEarlierVersionF _
pattern HasGTLowerBound <- LaterVersionF _
pattern HasTrailingZeroUpperBound <- (upperTrailingZero -> True)
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
Expand Down
2 changes: 1 addition & 1 deletion Cabal-syntax/src/Distribution/Version.hs
Original file line number Diff line number Diff line change
Expand Up @@ -50,7 +50,7 @@ module Distribution.Version
, stripParensVersionRange
, hasUpperBound
, hasLowerBound
, hasLEQUpperBound
, hasLEUpperBound
, hasTrailingZeroUpperBound
, hasGTLowerBound

Expand Down
6 changes: 3 additions & 3 deletions Cabal/src/Distribution/PackageDescription/Check.hs
Original file line number Diff line number Diff line change
Expand Up @@ -568,9 +568,9 @@ checkSetupBuildInfo (Just (SetupBuildInfo ds _)) = do
rck =
PackageDistSuspiciousWarn
. MissingUpperBounds CETSetup
lequck =
leuck =
PackageDistSuspiciousWarn
. LEQUpperBounds CETSetup
. LEUpperBounds CETSetup
tzuck =
PackageDistSuspiciousWarn
. TrailingZeroUpperBounds CETSetup
Expand All @@ -579,7 +579,7 @@ checkSetupBuildInfo (Just (SetupBuildInfo ds _)) = do
. GTLowerBounds CETSetup
checkPVP (checkDependencyVersionRange $ not . hasUpperBound) ick is
checkPVPs (checkDependencyVersionRange $ not . hasUpperBound) rck rs
checkPVPs (checkDependencyVersionRange hasLEQUpperBound) lequck ds
checkPVPs (checkDependencyVersionRange hasLEUpperBound) leuck ds
checkPVPs (checkDependencyVersionRange hasTrailingZeroUpperBound) tzuck ds
checkPVPs (checkDependencyVersionRange hasGTLowerBound) gtlck ds

Expand Down
4 changes: 2 additions & 2 deletions Cabal/src/Distribution/PackageDescription/Check/Target.hs
Original file line number Diff line number Diff line change
Expand Up @@ -339,7 +339,7 @@ checkBuildInfo cet ams ads bi = do
ds
let ick = const (PackageDistInexcusable BaseNoUpperBounds)
rck = PackageDistSuspiciousWarn . MissingUpperBounds cet
lequck = PackageDistSuspiciousWarn . LEQUpperBounds cet
leuck = PackageDistSuspiciousWarn . LEUpperBounds cet
tzuck = PackageDistSuspiciousWarn . TrailingZeroUpperBounds cet
gtlck = PackageDistSuspiciousWarn . GTLowerBounds cet
checkPVP (checkDependencyVersionRange $ not . hasUpperBound) ick ids
Expand All @@ -348,7 +348,7 @@ checkBuildInfo cet ams ads bi = do
(checkPVPs (checkDependencyVersionRange $ not . hasUpperBound) rck rds)
unless
(isInternalTarget cet)
(checkPVPs (checkDependencyVersionRange hasLEQUpperBound) lequck ds)
(checkPVPs (checkDependencyVersionRange hasLEUpperBound) leuck ds)
unless
(isInternalTarget cet)
(checkPVPs (checkDependencyVersionRange hasTrailingZeroUpperBound) tzuck ds)
Expand Down
10 changes: 5 additions & 5 deletions Cabal/src/Distribution/PackageDescription/Check/Warning.hs
Original file line number Diff line number Diff line change
Expand Up @@ -256,7 +256,7 @@ data CheckExplanation
| UnknownCompiler [String]
| BaseNoUpperBounds
| MissingUpperBounds CEType [String]
| LEQUpperBounds CEType [String]
| LEUpperBounds CEType [String]
| TrailingZeroUpperBounds CEType [String]
| GTLowerBounds CEType [String]
| SuspiciousFlagName [String]
Expand Down Expand Up @@ -422,7 +422,7 @@ data CheckExplanationID
| CIUnknownCompiler
| CIBaseNoUpperBounds
| CIMissingUpperBounds
| CILEQUpperBounds
| CILEUpperBounds
| CITrailingZeroUpperBounds
| CIGTLowerBounds
| CISuspiciousFlagName
Expand Down Expand Up @@ -567,7 +567,7 @@ checkExplanationId (UnknownArch{}) = CIUnknownArch
checkExplanationId (UnknownCompiler{}) = CIUnknownCompiler
checkExplanationId (BaseNoUpperBounds{}) = CIBaseNoUpperBounds
checkExplanationId (MissingUpperBounds{}) = CIMissingUpperBounds
checkExplanationId (LEQUpperBounds{}) = CILEQUpperBounds
checkExplanationId (LEUpperBounds{}) = CILEUpperBounds
checkExplanationId (TrailingZeroUpperBounds{}) = CITrailingZeroUpperBounds
checkExplanationId (GTLowerBounds{}) = CIGTLowerBounds
checkExplanationId (SuspiciousFlagName{}) = CISuspiciousFlagName
Expand Down Expand Up @@ -720,7 +720,7 @@ 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 CILEQUpperBounds = "le-upper-bounds"
ppCheckExplanationId CILEUpperBounds = "le-upper-bounds"
ppCheckExplanationId CITrailingZeroUpperBounds = "tz-upper-bounds"
ppCheckExplanationId CIGTLowerBounds = "gt-lower-bounds"
ppCheckExplanationId CISuspiciousFlagName = "suspicious-flag"
Expand Down Expand Up @@ -1322,7 +1322,7 @@ ppExplanation (MissingUpperBounds ct names) =
++ "these packages miss upper bounds:"
++ listSep names
++ "Please add them. There is more information at https://pvp.haskell.org/"
ppExplanation (LEQUpperBounds ct names) =
ppExplanation (LEUpperBounds ct names) =
"On "
++ ppCET ct
++ ", "
Expand Down

0 comments on commit 4b2559c

Please sign in to comment.