Disallow wildcards and operators when spec is old

phadej · phadej · commit e67f1933cb0b · 2020-03-16T16:28:43.000+02:00
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
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
0 files failed to parse
130.969593s elapsed
132.016403s elapsed
134.214536s elapsed
128.753382s elapsed
131.503804s elapsed
```

The slowdown is acceptable, and I have an idea which may mitigate
this.

Note how 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.
diff --git a/Cabal/Distribution/PackageDescription/Check.hs b/Cabal/Distribution/PackageDescription/Check.hs
@@ -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
@@ -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 $
@@ -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
@@ -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 =
@@ -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
 -- ------------------------------------------------------------
diff --git a/Cabal/Distribution/Parsec.hs b/Cabal/Distribution/Parsec.hs
@@ -9,9 +9,12 @@ module Distribution.Parsec (
     runParsecParser,
     runParsecParser',
     simpleParsec,
+    simpleParsec',
+    simpleParsecW',
     lexemeParsec,
     eitherParsec,
     explicitEitherParsec,
+    explicitEitherParsec',
     -- * CabalParsing and and diagnostics
     CabalParsing (..),
     -- ** Warnings
@@ -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
@@ -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
diff --git a/Cabal/Distribution/Parsec/Warning.hs b/Cabal/Distribution/Parsec/Warning.hs
@@ -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
diff --git a/Cabal/Distribution/Types/PkgconfigVersionRange.hs b/Cabal/Distribution/Types/PkgconfigVersionRange.hs
@@ -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
diff --git a/Cabal/Distribution/Types/VersionRange/Internal.hs b/Cabal/Distribution/Types/VersionRange/Internal.hs
@@ -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
@@ -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)
@@ -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)
@@ -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))
@@ -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
@@ -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
@@ -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
@@ -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
