Merge pull request #11571 from tbidne/tbidne/11518-check

Add check for "dotlines" with cabal 3.0+

Author: mergify[bot]

Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs

@@ -66,6 +66,7 @@ module Distribution.FieldGrammar.Parsec
   , runFieldParser
   , runFieldParser'
   , fieldLinesToStream
+  , freeTextIgnoreDotlineVers
   ) where
 
 import Distribution.Compat.Newtype
@@ -234,7 +235,7 @@ instance FieldGrammar Parsec ParsecFieldGrammar where
 
       parseOne v (MkNamelessField pos fls)
         | null fls = pure Nothing
-        | v >= CabalSpecV3_0 = pure (Just (fieldlinesToFreeText3 pos fls))
+        | v >= freeTextIgnoreDotlineVers = pure (Just (fieldlinesToFreeText3 pos fls))
         | otherwise = pure (Just (fieldlinesToFreeText fls))
 
   freeTextFieldDef fn _ = ParsecFG (Set.singleton fn) Set.empty parser
@@ -249,7 +250,7 @@ instance FieldGrammar Parsec ParsecFieldGrammar where
 
       parseOne v (MkNamelessField pos fls)
         | null fls = pure ""
-        | v >= CabalSpecV3_0 = pure (fieldlinesToFreeText3 pos fls)
+        | v >= freeTextIgnoreDotlineVers = pure (fieldlinesToFreeText3 pos fls)
         | otherwise = pure (fieldlinesToFreeText fls)
 
   -- freeTextFieldDefST = defaultFreeTextFieldDefST
@@ -267,7 +268,7 @@ instance FieldGrammar Parsec ParsecFieldGrammar where
         [] -> pure mempty
         [FieldLine _ bs] -> pure (ShortText.unsafeFromUTF8BS bs)
         _
-          | v >= CabalSpecV3_0 -> pure (ShortText.toShortText $ fieldlinesToFreeText3 pos fls)
+          | v >= freeTextIgnoreDotlineVers -> pure (ShortText.toShortText $ fieldlinesToFreeText3 pos fls)
           | otherwise -> pure (ShortText.toShortText $ fieldlinesToFreeText fls)
 
   monoidalFieldAla fn _pack _extract = ParsecFG (Set.singleton fn) Set.empty parser
@@ -411,6 +412,11 @@ fieldlinesToFreeText fls = intercalate "\n" (map go fls)
       where
         s = trim (fromUTF8BS bs)
 
+-- | Cabal version where we switch from the old free text parser that had
+-- special logic for "dotlines" to a new parser that has no such logic.
+freeTextIgnoreDotlineVers :: CabalSpecVersion
+freeTextIgnoreDotlineVers = CabalSpecV3_0
+
 fieldlinesToFreeText3 :: Position -> [FieldLine Position] -> String
 fieldlinesToFreeText3 _ [] = ""
 fieldlinesToFreeText3 _ [FieldLine _ bs] = fromUTF8BS bs

Cabal/src/Distribution/PackageDescription/Check.hs

@@ -47,9 +47,11 @@ import Distribution.Compat.Prelude
 import Prelude ()
 
 import Data.List (group)
+import qualified Data.List as L
 import Distribution.CabalSpecVersion
 import Distribution.Compat.Lens
 import Distribution.Compiler
+import Distribution.FieldGrammar.Parsec (freeTextIgnoreDotlineVers)
 import Distribution.License
 import Distribution.ModuleName (toFilePath)
 import Distribution.Package
@@ -85,6 +87,7 @@ import qualified System.FilePath.Windows as FilePath.Windows (isValid)
 
 import qualified Data.Set as Set
 import qualified Distribution.Utils.ShortText as ShortText
+import qualified Distribution.Utils.String as String
 
 import qualified Distribution.Types.GenericPackageDescription.Lens as L
 
@@ -464,6 +467,20 @@ checkPackageDescription
       )
       (PackageDistSuspicious ShortDesc)
 
+    -- § Freeform fields no longer include "dotlines". Generally taken from
+    -- Distribution.PackageDescription.FieldGrammar fields that use some
+    -- freeTextField parser.
+    checkDotline "author" _author_
+    checkDotline "bug-reports" _bugReports_
+    checkDotline "category" category_
+    checkDotline "copyright" _copyright_
+    checkDotline "description" description_
+    checkDotline "homepage" _homepage_
+    checkDotline "maintainer" maintainer_
+    checkDotline "package-url" _pkgUrl_
+    checkDotline "stability" _stability_
+    checkDotline "synopsis" synopsis_
+
     -- § Paths.
     mapM_ (checkPath False "extra-source-files" PathKindGlob . getSymbolicPath) extraSrcFiles_
     mapM_ (checkPath False "extra-tmp-files" PathKindFile . getSymbolicPath) extraTmpFiles_
@@ -570,6 +587,19 @@ checkPackageDescription
              in tellP (PackageDistInexcusable (InvalidTestWith dep))
           )
 
+-- | Issue a warning if the text contains any "dotlines".
+checkDotline :: Monad m => String -> ShortText.ShortText -> CheckM m ()
+checkDotline fieldName fieldVal = do
+  checkSpecVerGte
+    freeTextIgnoreDotlineVers
+    (hasDotline fieldVal)
+    (PackageDistSuspiciousWarn $ FreeTextDotline fieldName)
+  where
+    hasDotline =
+      L.any ((== ".") . String.trim)
+        . L.lines
+        . ShortText.fromShortText
+
 checkSetupBuildInfo :: Monad m => Maybe SetupBuildInfo -> CheckM m ()
 checkSetupBuildInfo Nothing = return ()
 checkSetupBuildInfo (Just (SetupBuildInfo ds _)) = do

Cabal/src/Distribution/PackageDescription/Check/Monad.hs

@@ -39,6 +39,7 @@ module Distribution.PackageDescription.Check.Monad
   , liftInt
   , tellP
   , checkSpecVer
+  , checkSpecVerGte
   ) where
 
 import Distribution.Compat.Prelude
@@ -369,3 +370,16 @@ checkSpecVer
 checkSpecVer vc cond c = do
   vp <- asksCM ccSpecVersion
   unless (vp >= vc) (checkP cond c)
+
+-- | Like 'checkSpecVer', except performs the check when our
+-- spec version >= the param.
+checkSpecVerGte
+  :: Monad m
+  => CabalSpecVersion -- Perform this check only if our
+  -- spec version is >= than this.
+  -> Bool -- Check condition.
+  -> PackageCheck -- Check message.
+  -> CheckM m ()
+checkSpecVerGte vc cond c = do
+  vp <- asksCM ccSpecVersion
+  when (vp >= vc) (checkP cond c)

Cabal/src/Distribution/PackageDescription/Check/Warning.hs

@@ -170,6 +170,7 @@ data CheckExplanation
   | UnknownExtensions [String]
   | LanguagesAsExtension [String]
   | DeprecatedExtensions [(Extension, Maybe Extension)]
+  | FreeTextDotline String
   | MissingFieldCategory
   | MissingFieldMaintainer
   | MissingFieldSynopsis
@@ -337,6 +338,7 @@ data CheckExplanationID
   | CIUnknownExtensions
   | CILanguagesAsExtension
   | CIDeprecatedExtensions
+  | CIFreeTextDotline
   | CIMissingFieldCategory
   | CIMissingFieldMaintainer
   | CIMissingFieldSynopsis
@@ -483,6 +485,7 @@ checkExplanationId (UnknownLanguages{}) = CIUnknownLanguages
 checkExplanationId (UnknownExtensions{}) = CIUnknownExtensions
 checkExplanationId (LanguagesAsExtension{}) = CILanguagesAsExtension
 checkExplanationId (DeprecatedExtensions{}) = CIDeprecatedExtensions
+checkExplanationId (FreeTextDotline{}) = CIFreeTextDotline
 checkExplanationId (MissingFieldCategory{}) = CIMissingFieldCategory
 checkExplanationId (MissingFieldMaintainer{}) = CIMissingFieldMaintainer
 checkExplanationId (MissingFieldSynopsis{}) = CIMissingFieldSynopsis
@@ -636,6 +639,7 @@ ppCheckExplanationId CIUnknownLanguages = "unknown-languages"
 ppCheckExplanationId CIUnknownExtensions = "unknown-extension"
 ppCheckExplanationId CILanguagesAsExtension = "languages-as-extensions"
 ppCheckExplanationId CIDeprecatedExtensions = "deprecated-extensions"
+ppCheckExplanationId CIFreeTextDotline = "free-text-dotline"
 ppCheckExplanationId CIMissingFieldCategory = "no-category"
 ppCheckExplanationId CIMissingFieldMaintainer = "no-maintainer"
 ppCheckExplanationId CIMissingFieldSynopsis = "no-synopsis"
@@ -910,6 +914,11 @@ ppExplanation (DeprecatedExtensions ourDeprecatedExtensions) =
         ++ "'."
       | (ext, Just replacement) <- ourDeprecatedExtensions
       ]
+ppExplanation (FreeTextDotline field) =
+  "Empty lines with a dot '.' in field '"
+    ++ field
+    ++ "' are unnecessary for creating newlines "
+    ++ "(and treated literally) in cabal 3.0+"
 ppExplanation MissingFieldCategory = "No 'category' field."
 ppExplanation MissingFieldMaintainer = "No 'maintainer' field."
 ppExplanation MissingFieldSynopsis = "No 'synopsis' field."

cabal-testsuite/PackageTests/DotlineWarning/Post3.0/cabal.out

@@ -0,0 +1,18 @@
+# cabal v2-build
+Resolving dependencies...
+Build profile: -w ghc-<GHCVER> -O1
+In order, the following would be built:
+ - main-0.1 (lib) (first run)
+
+# cabal check
+These warnings may cause trouble when distributing the package:
+Warning: [free-text-dotline] Empty lines with a dot '.' in field 'author' are unnecessary for creating newlines (and treated literally) in cabal 3.0+
+Warning: [free-text-dotline] Empty lines with a dot '.' in field 'bug-reports' are unnecessary for creating newlines (and treated literally) in cabal 3.0+
+Warning: [free-text-dotline] Empty lines with a dot '.' in field 'category' are unnecessary for creating newlines (and treated literally) in cabal 3.0+
+Warning: [free-text-dotline] Empty lines with a dot '.' in field 'copyright' are unnecessary for creating newlines (and treated literally) in cabal 3.0+
+Warning: [free-text-dotline] Empty lines with a dot '.' in field 'description' are unnecessary for creating newlines (and treated literally) in cabal 3.0+
+Warning: [free-text-dotline] Empty lines with a dot '.' in field 'homepage' are unnecessary for creating newlines (and treated literally) in cabal 3.0+
+Warning: [free-text-dotline] Empty lines with a dot '.' in field 'maintainer' are unnecessary for creating newlines (and treated literally) in cabal 3.0+
+Warning: [free-text-dotline] Empty lines with a dot '.' in field 'package-url' are unnecessary for creating newlines (and treated literally) in cabal 3.0+
+Warning: [free-text-dotline] Empty lines with a dot '.' in field 'stability' are unnecessary for creating newlines (and treated literally) in cabal 3.0+
+Warning: [free-text-dotline] Empty lines with a dot '.' in field 'synopsis' are unnecessary for creating newlines (and treated literally) in cabal 3.0+

cabal-testsuite/PackageTests/DotlineWarning/Post3.0/cabal.test.hs

@@ -0,0 +1,6 @@
+import Test.Cabal.Prelude
+
+main = cabalTest $ do
+  cabal "v2-build" ["--dry-run"]
+
+  cabal "check" []

cabal-testsuite/PackageTests/DotlineWarning/Post3.0/main.cabal

@@ -0,0 +1,57 @@
+cabal-version: 3.0
+
+name: main
+version: 0.1
+build-type: Simple
+category:
+  Some
+  .
+  Category
+author:
+  Joe
+  .
+  Author
+stability:
+  Some
+  .
+  Stability
+homepage:
+  Some
+  .
+  homepace
+package-url:
+  Some
+  .
+  url
+maintainer:
+  Joe
+  .
+  Maintainer
+copyright:
+  Some
+  .
+  text
+bug-reports:
+  Some
+  .
+  bugs
+synopsis:
+  Test input
+  .
+  with
+  .
+  lines
+description:
+  .
+  Some . description
+  .
+  spanning .
+  .
+  multiple lines.
+  .
+license: BSD-3-Clause
+
+library
+  exposed-modules: Lib
+  build-depends: base <6
+  default-language: Haskell2010

cabal-testsuite/PackageTests/DotlineWarning/Post3.0/src/Lib.hs

@@ -0,0 +1 @@
+module Lib where

cabal-testsuite/PackageTests/DotlineWarning/Pre3.0/cabal.out

@@ -0,0 +1,8 @@
+# cabal v2-build
+Resolving dependencies...
+Build profile: -w ghc-<GHCVER> -O1
+In order, the following would be built:
+ - main-0.1 (lib) (first run)
+
+# cabal check
+No errors or warnings could be found in the package.

cabal-testsuite/PackageTests/DotlineWarning/Pre3.0/cabal.test.hs

@@ -0,0 +1,6 @@
+import Test.Cabal.Prelude
+
+main = cabalTest $ do
+  cabal "v2-build" ["--dry-run"]
+
+  cabal "check" []