Skip to content

Commit

Permalink
Disallow wildcards and operators when spec is old
Browse files Browse the repository at this point in the history
Do this already in the Parsec instance parser.
This allows removing checks from `D.PD.Check`.
Later this would also allow removing non-relevant
constructors from `VersionRange`, allowing easier testing.

This change causes 10% slowdown: from

```
135768 files processed
  7350 files contained warnings
113156 files have check warnings
     0 files failed to parse

120.901201s elapsed
117.640431s elapsed
119.663620s elapsed
119.454329s elapsed
119.785214s elapsed
```

to

```
135768 files processed
 31912 files contained warnings
113109 files have check warnings
     0 files failed to parse

130.969593s elapsed
132.016403s elapsed
134.214536s elapsed
128.753382s elapsed
131.503804s elapsed
```

I hope the slowdown is acceptable, and I have an idea which may mitigate
this. I'll try out it after I done further refactorings.

Note how (parser) warnings grew by a factor. There are plenty of (old)
files on Hackage, which don't use correct cabal-version.  For that
reason we only issue warnings, and not fail.  Quirks approach won't
scale for these. In comparison, there are even more files
with check warnings
  • Loading branch information
phadej committed Mar 16, 2020
1 parent a65d28b commit ef0699a
Show file tree
Hide file tree
Showing 24 changed files with 132 additions and 153 deletions.
2 changes: 2 additions & 0 deletions Cabal/Cabal.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -246,13 +246,15 @@ extra-source-files:
tests/ParserTests/warnings/nbsp.cabal
tests/ParserTests/warnings/newsyntax.cabal
tests/ParserTests/warnings/oldsyntax.cabal
tests/ParserTests/warnings/operator.cabal
tests/ParserTests/warnings/subsection.cabal
tests/ParserTests/warnings/tab.cabal
tests/ParserTests/warnings/trailingfield.cabal
tests/ParserTests/warnings/unknownfield.cabal
tests/ParserTests/warnings/unknownsection.cabal
tests/ParserTests/warnings/utf8.cabal
tests/ParserTests/warnings/versiontag.cabal
tests/ParserTests/warnings/wildcard.cabal
tests/cbits/rpmvercmp.c
tests/hackage/check.sh
tests/hackage/download.sh
Expand Down
123 changes: 0 additions & 123 deletions Cabal/Distribution/PackageDescription/Check.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1253,40 +1253,6 @@ checkCabalVersion pkg =
++ "the 'other-extensions' field lists extensions that are used in "
++ "some modules, e.g. via the {-# LANGUAGE #-} pragma."

-- check use of "foo (>= 1.0 && < 1.4) || >=1.8 " version-range syntax
, checkVersion [1,8] (not (null versionRangeExpressions)) $
PackageDistInexcusable $
"The package uses full version-range expressions "
++ "in a 'build-depends' field: "
++ commaSep (map displayRawDependency versionRangeExpressions)
++ ". To use this new syntax the package needs to specify at least "
++ "'cabal-version: >= 1.8'. Alternatively, if broader compatibility "
++ "is important, then convert to conjunctive normal form, and use "
++ "multiple 'build-depends:' lines, one conjunct per line."

-- check use of "build-depends: foo == 1.*" syntax
, checkVersion [1,6] (not (null depsUsingWildcardSyntax)) $
PackageDistInexcusable $
"The package uses wildcard syntax in the 'build-depends' field: "
++ commaSep (map prettyShow depsUsingWildcardSyntax)
++ ". To use this new syntax the package need to specify at least "
++ "'cabal-version: >= 1.6'. Alternatively, if broader compatibility "
++ "is important then use: " ++ commaSep
[ prettyShow (Dependency name (eliminateWildcardSyntax versionRange) Set.empty)
| Dependency name versionRange _ <- depsUsingWildcardSyntax ]

-- check use of "build-depends: foo ^>= 1.2.3" syntax
, checkVersion [2,0] (not (null depsUsingMajorBoundSyntax)) $
PackageDistInexcusable $
"The package uses major bounded version syntax in the "
++ "'build-depends' field: "
++ commaSep (map prettyShow depsUsingMajorBoundSyntax)
++ ". To use this new syntax the package need to specify at least "
++ "'cabal-version: 2.0'. Alternatively, if broader compatibility "
++ "is important then use: " ++ commaSep
[ prettyShow (Dependency name (eliminateMajorBoundSyntax versionRange) Set.empty)
| Dependency name versionRange _ <- depsUsingMajorBoundSyntax ]

, checkVersion [3,0] (any (not . null)
(concatMap buildInfoField
[ asmSources
Expand All @@ -1312,26 +1278,6 @@ checkCabalVersion pkg =
"The use of 'virtual-modules' requires the package "
++ " to specify at least 'cabal-version: >= 2.1'."

-- check use of "tested-with: GHC (>= 1.0 && < 1.4) || >=1.8 " syntax
, checkVersion [1,8] (not (null testedWithVersionRangeExpressions)) $
PackageDistInexcusable $
"The package uses full version-range expressions "
++ "in a 'tested-with' field: "
++ commaSep (map displayRawDependency testedWithVersionRangeExpressions)
++ ". To use this new syntax the package needs to specify at least "
++ "'cabal-version: >= 1.8'."

-- check use of "tested-with: GHC == 6.12.*" syntax
, checkVersion [1,6] (not (null testedWithUsingWildcardSyntax)) $
PackageDistInexcusable $
"The package uses wildcard syntax in the 'tested-with' field: "
++ commaSep (map prettyShow testedWithUsingWildcardSyntax)
++ ". To use this new syntax the package need to specify at least "
++ "'cabal-version: >= 1.6'. Alternatively, if broader compatibility "
++ "is important then use: " ++ commaSep
[ prettyShow (Dependency name (eliminateWildcardSyntax versionRange) Set.empty)
| Dependency name versionRange _ <- testedWithUsingWildcardSyntax ]

-- check use of "source-repository" section
, checkVersion [1,6] (not (null (sourceRepos pkg))) $
PackageDistInexcusable $
Expand Down Expand Up @@ -1403,15 +1349,6 @@ checkCabalVersion pkg =

buildInfoField field = map field (allBuildInfo pkg)

versionRangeExpressions =
[ dep | dep@(Dependency _ vr _) <- allBuildDepends pkg
, usesNewVersionRangeSyntax vr ]

testedWithVersionRangeExpressions =
[ Dependency (mkPackageName (prettyShow compiler)) vr Set.empty
| (compiler, vr) <- testedWith pkg
, usesNewVersionRangeSyntax vr ]

simpleSpecVersionRangeSyntax =
either (const True) (cataVersionRange alg) (specVersionRaw pkg)
where
Expand All @@ -1422,63 +1359,8 @@ checkCabalVersion pkg =
simpleSpecVersionSyntax =
either (const True) (const False) (specVersionRaw pkg)

usesNewVersionRangeSyntax :: VersionRange -> Bool
usesNewVersionRangeSyntax
= (> 2) -- uses the new syntax if depth is more than 2
. cataVersionRange alg
where
alg (UnionVersionRangesF a b) = a + b
alg (IntersectVersionRangesF a b) = a + b
alg (VersionRangeParensF _) = 3
alg _ = 1 :: Int

depsUsingWildcardSyntax = [ dep | dep@(Dependency _ vr _) <- allBuildDepends pkg
, usesWildcardSyntax vr ]

depsUsingMajorBoundSyntax = [ dep | dep@(Dependency _ vr _) <- allBuildDepends pkg
, usesMajorBoundSyntax vr ]

usesBackpackIncludes = any (not . null . mixins) (allBuildInfo pkg)

testedWithUsingWildcardSyntax =
[ Dependency (mkPackageName (prettyShow compiler)) vr Set.empty
| (compiler, vr) <- testedWith pkg
, usesWildcardSyntax vr ]

usesWildcardSyntax :: VersionRange -> Bool
usesWildcardSyntax = cataVersionRange alg
where
alg (WildcardVersionF _) = True
alg (UnionVersionRangesF a b) = a || b
alg (IntersectVersionRangesF a b) = a || b
alg (VersionRangeParensF a) = a
alg _ = False

-- NB: this eliminates both, WildcardVersion and MajorBoundVersion
-- because when WildcardVersion is not support, neither is MajorBoundVersion
eliminateWildcardSyntax = hyloVersionRange embed projectVersionRange
where
embed (WildcardVersionF v) = intersectVersionRanges
(orLaterVersion v) (earlierVersion (wildcardUpperBound v))
embed (MajorBoundVersionF v) = intersectVersionRanges
(orLaterVersion v) (earlierVersion (majorUpperBound v))
embed vr = embedVersionRange vr

usesMajorBoundSyntax :: VersionRange -> Bool
usesMajorBoundSyntax = cataVersionRange alg
where
alg (MajorBoundVersionF _) = True
alg (UnionVersionRangesF a b) = a || b
alg (IntersectVersionRangesF a b) = a || b
alg (VersionRangeParensF a) = a
alg _ = False

eliminateMajorBoundSyntax = hyloVersionRange embed projectVersionRange
where
embed (MajorBoundVersionF v) = intersectVersionRanges
(orLaterVersion v) (earlierVersion (majorUpperBound v))
embed vr = embedVersionRange vr

mentionedExtensions = [ ext | bi <- allBuildInfo pkg
, ext <- allExtensions bi ]
mentionedExtensionsThatNeedCabal12 =
Expand Down Expand Up @@ -1529,11 +1411,6 @@ checkCabalVersion pkg =

allModuleNamesAutogen = concatMap autogenModules (allBuildInfo pkg)

displayRawDependency :: Dependency -> String
displayRawDependency (Dependency pkg vr _sublibs) =
prettyShow pkg ++ " " ++ prettyShow vr


-- ------------------------------------------------------------
-- * Checks on the GenericPackageDescription
-- ------------------------------------------------------------
Expand Down
33 changes: 33 additions & 0 deletions Cabal/Distribution/Parsec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,9 +9,12 @@ module Distribution.Parsec (
runParsecParser,
runParsecParser',
simpleParsec,
simpleParsec',
simpleParsecW',
lexemeParsec,
eitherParsec,
explicitEitherParsec,
explicitEitherParsec',
-- * CabalParsing and and diagnostics
CabalParsing (..),
-- ** Warnings
Expand Down Expand Up @@ -171,6 +174,25 @@ simpleParsec
. runParsecParser lexemeParsec "<simpleParsec>"
. fieldLineStreamFromString

-- | Parse a 'String' with 'lexemeParsec' using specific 'CabalSpecVersion'.
--
-- @since 3.4.0.0
simpleParsec' :: Parsec a => CabalSpecVersion -> String -> Maybe a
simpleParsec' spec
= either (const Nothing) Just
. runParsecParser' spec lexemeParsec "<simpleParsec>"
. fieldLineStreamFromString

-- | Parse a 'String' with 'lexemeParsec' using specific 'CabalSpecVersion'.
-- Fail if there are any warnings.
--
-- @since 3.4.0.0
simpleParsecW' :: Parsec a => CabalSpecVersion -> String -> Maybe a
simpleParsecW' spec
= either (const Nothing) (\(x, ws) -> if null ws then Just x else Nothing)
. runParsecParser' spec ((,) <$> lexemeParsec <*> liftParsec Parsec.getState) "<simpleParsec>"
. fieldLineStreamFromString

-- | Parse a 'String' with 'lexemeParsec'.
eitherParsec :: Parsec a => String -> Either String a
eitherParsec = explicitEitherParsec parsec
Expand All @@ -182,6 +204,17 @@ explicitEitherParsec parser
. runParsecParser (parser <* P.spaces) "<eitherParsec>"
. fieldLineStreamFromString

-- | Parse a 'String' with given 'ParsecParser' and 'CabalSpecVersion'. Trailing whitespace is accepted.
-- See 'explicitEitherParsec'.
--
-- @since 3.4.0.0
--
explicitEitherParsec' :: CabalSpecVersion -> ParsecParser a -> String -> Either String a
explicitEitherParsec' spec parser
= either (Left . show) Right
. runParsecParser' spec (parser <* P.spaces) "<eitherParsec>"
. fieldLineStreamFromString

-- | Run 'ParsecParser' with 'cabalSpecLatest'.
runParsecParser :: ParsecParser a -> FilePath -> FieldLineStream -> Either Parsec.ParseError a
runParsecParser = runParsecParser' cabalSpecLatest
Expand Down
3 changes: 3 additions & 0 deletions Cabal/Distribution/Parsec/Warning.hs
Original file line number Diff line number Diff line change
Expand Up @@ -35,6 +35,9 @@ data PWarnType
| PWTDoubleDash -- ^ Double dash token, most likely it's a mistake - it's not a comment
| PWTMultipleSingularField -- ^ e.g. name or version should be specified only once.
| PWTBuildTypeDefault -- ^ Workaround for derive-package having build-type: Default. See <https://github.com/haskell/cabal/issues/5020>.

| PWTVersionOperator -- ^ Version operators used (without cabal-version: 1.8)
| PWTVersionWildcard -- ^ Version wildcard used (without cabal-version: 1.6)
deriving (Eq, Ord, Show, Enum, Bounded, Generic)

instance Binary PWarnType
Expand Down
2 changes: 1 addition & 1 deletion Cabal/Distribution/Types/PkgconfigVersionRange.hs
Original file line number Diff line number Diff line change
Expand Up @@ -69,7 +69,7 @@ instance Parsec PkgconfigVersionRange where
csv <- askCabalSpecVersion
if csv >= CabalSpecV3_0
then pkgconfigParser
else versionRangeToPkgconfigVersionRange <$> versionRangeParser P.integral
else versionRangeToPkgconfigVersionRange <$> versionRangeParser P.integral csv

-- "modern" parser of @pkg-config@ package versions.
pkgconfigParser :: CabalParsing m => m PkgconfigVersionRange
Expand Down
75 changes: 62 additions & 13 deletions Cabal/Distribution/Types/VersionRange/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -262,8 +262,40 @@ instance Pretty VersionRange where
punct p p' | p < p' = Disp.parens
| otherwise = id

-- |
--
-- >>> simpleParsec "^>= 3.4" :: Maybe VersionRange
-- Just (MajorBoundVersion (mkVersion [3,4]))
--
-- Small history:
--
-- Set operations are introduced in 3.0
--
-- >>> map (`simpleParsec'` "^>= { 1.2 , 1.3 }") [CabalSpecV2_4, CabalSpecV3_0] :: [Maybe VersionRange]
-- [Nothing,Just (UnionVersionRanges (MajorBoundVersion (mkVersion [1,2])) (MajorBoundVersion (mkVersion [1,3])))]
--
-- @^>=@ is introduced in 2.0
--
-- >>> map (`simpleParsec'` "^>=1.2") [CabalSpecV1_24, CabalSpecV2_0] :: [Maybe VersionRange]
-- [Nothing,Just (MajorBoundVersion (mkVersion [1,2]))]
--
-- @-none@ is introduced in 1.22
--
-- >>> map (`simpleParsec'` "-none") [CabalSpecV1_20, CabalSpecV1_22] :: [Maybe VersionRange]
-- [Nothing,Just (IntersectVersionRanges (LaterVersion (mkVersion [1])) (EarlierVersion (mkVersion [1])))]
--
-- Operators are introduced in 1.8. Issues only a warning.
--
-- >>> map (`simpleParsecW'` "== 1 || ==2") [CabalSpecV1_6, CabalSpecV1_8] :: [Maybe VersionRange]
-- [Nothing,Just (UnionVersionRanges (ThisVersion (mkVersion [1])) (ThisVersion (mkVersion [2])))]
--
-- Wild-version ranges are introduced in 1.6. Issues only a warning.
--
-- >>> map (`simpleParsecW'` "== 1.2.*") [CabalSpecV1_4, CabalSpecV1_6] :: [Maybe VersionRange]
-- [Nothing,Just (WildcardVersion (mkVersion [1,2]))]
--
instance Parsec VersionRange where
parsec = versionRangeParser versionDigitParser
parsec = askCabalSpecVersion >>= versionRangeParser versionDigitParser

instance Described VersionRange where
describe _ = RERec "version-range" $ REUnion
Expand Down Expand Up @@ -301,13 +333,14 @@ instance Described VersionRange where
-- versions, 'PkgConfigVersionRange'.
--
-- @since 3.0
versionRangeParser :: forall m. CabalParsing m => m Int -> m VersionRange
versionRangeParser digitParser = expr
versionRangeParser :: forall m. CabalParsing m => m Int -> CabalSpecVersion -> m VersionRange
versionRangeParser digitParser csv = expr
where
expr = do P.spaces
t <- term
P.spaces
(do _ <- P.string "||"
checkOp
P.spaces
e <- expr
return (unionVersionRanges t e)
Expand All @@ -316,6 +349,7 @@ versionRangeParser digitParser = expr
term = do f <- factor
P.spaces
(do _ <- P.string "&&"
checkOp
P.spaces
t <- term
return (intersectVersionRanges f t)
Expand All @@ -331,6 +365,7 @@ versionRangeParser digitParser = expr
"==" -> do
P.spaces
(do (wild, v) <- verOrWild
checkWild wild
pure $ (if wild then withinVersion else thisVersion) v
<|>
(verSet' thisVersion =<< verSet))
Expand All @@ -356,6 +391,27 @@ versionRangeParser digitParser = expr
">" -> pure $ laterVersion v
_ -> fail $ "Unknown version operator " ++ show op

-- Cannot be warning
-- On 2020-03-16 there was around 27400 files on Hackage failing to parse due this
-- For example https://hackage.haskell.org/package/haxr-3000.0.0/haxr.cabal
--
checkOp = when (csv < CabalSpecV1_8) $
parsecWarning PWTVersionOperator $ unwords
[ "version operators used."
, "To use version operators the package needs to specify at least 'cabal-version: >= 1.8'."
]

-- Cannot be warning
-- On 2020-03-16 there was 46 files on Hackage failing to parse due this
-- For example https://hackage.haskell.org/package/derive-0.1.2/derive.cabal
--
checkWild False = pure ()
checkWild True = when (csv < CabalSpecV1_6) $
parsecWarning PWTVersionWildcard $ unwords
[ "Wildcard syntax used."
, "To use version wildcards the package needs to specify at least 'cabal-version: >= 1.6'."
]

-- https://gitlab.haskell.org/ghc/ghc/issues/17752
isOpChar '<' = True
isOpChar '=' = True
Expand All @@ -364,13 +420,8 @@ versionRangeParser digitParser = expr
isOpChar '-' = True
isOpChar _ = False

-- Note: There are other features:
-- && and || since 1.8
-- x.y.* (wildcard) since 1.6

-- -none version range is available since 1.22
noVersion' = do
csv <- askCabalSpecVersion
noVersion' =
if csv >= CabalSpecV1_22
then pure noVersion
else fail $ unwords
Expand All @@ -381,8 +432,7 @@ versionRangeParser digitParser = expr
]

-- ^>= is available since 2.0
majorBoundVersion' v = do
csv <- askCabalSpecVersion
majorBoundVersion' v =
if csv >= CabalSpecV2_0
then pure $ majorBoundVersion v
else fail $ unwords
Expand All @@ -398,8 +448,7 @@ versionRangeParser digitParser = expr
embed vr = embedVersionRange vr

-- version set notation (e.g. "== { 0.0.1.0, 0.0.2.0, 0.1.0.0 }")
verSet' op vs = do
csv <- askCabalSpecVersion
verSet' op vs =
if csv >= CabalSpecV3_0
then pure $ foldr1 unionVersionRanges (fmap op vs)
else fail $ unwords
Expand Down
3 changes: 2 additions & 1 deletion Cabal/tests/ParserTests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -66,7 +66,8 @@ warningTests = testGroup "warnings triggered"
, warningTest PWTTrailingFields "trailingfield.cabal"
, warningTest PWTDoubleDash "doubledash.cabal"
, warningTest PWTMultipleSingularField "multiplesingular.cabal"
, warningTest PWTMultipleSingularField "multiplesingular.cabal"
, warningTest PWTVersionWildcard "wildcard.cabal"
, warningTest PWTVersionOperator "operator.cabal"
-- TODO: not implemented yet
-- , warningTest PWTExtraTestModule "extratestmodule.cabal"
]
Expand Down
Loading

0 comments on commit ef0699a

Please sign in to comment.