cabal check: Warn if changelogs are omitted from extra-doc-files

Cabal/src/Distribution/PackageDescription/Check.hs

@@ -36,10 +36,11 @@ module Distribution.PackageDescription.Check (
         checkPackageFileNames,
   ) where
 
+import Data.Foldable                                 (foldrM)
 import Distribution.Compat.Prelude
 import Prelude ()
 
-import Data.List                                     (group)
+import Data.List                                     (delete, group)
 import Distribution.CabalSpecVersion
 import Distribution.Compat.Lens
 import Distribution.Compiler
@@ -64,7 +65,8 @@ import Distribution.Version
 import Distribution.Utils.Path
 import Language.Haskell.Extension
 import System.FilePath
-       (splitDirectories, splitExtension, splitPath, takeExtension, takeFileName, (<.>), (</>))
+       ( makeRelative, normalise, splitDirectories, splitExtension, splitPath
+       , takeExtension, takeFileName, (<.>), (</>))
 
 import qualified Data.ByteString.Lazy      as BS
 import qualified Data.Map                  as Map
@@ -251,6 +253,8 @@ data CheckExplanation =
         | MissingConfigureScript
         | UnknownDirectory String FilePath
         | MissingSourceControl
+        | MissingExpectedDocFiles Bool [FilePath]
+        | WrongFieldForExpectedDocFiles Bool String [FilePath]
     deriving (Eq, Ord, Show)
 
 -- | Wraps `ParseWarning` into `PackageCheck`.
@@ -786,6 +790,24 @@ ppExplanation MissingSourceControl =
       ++ "control information in the .cabal file using one or more "
       ++ "'source-repository' sections. See the Cabal user guide for "
       ++ "details."
+ppExplanation (MissingExpectedDocFiles extraDocFileSupport paths) =
+    "Please consider including the " ++ quotes paths
+      ++ " in the '" ++ targetField ++ "' section of the .cabal file "
+      ++ "if it contains useful information for users of the package."
+  where quotes [p] = "file " ++ quote p
+        quotes ps = "files " ++ intercalate ", " (map quote ps)
+        targetField = if extraDocFileSupport
+                        then "extra-doc-files"
+                        else "extra-source-files"
+ppExplanation (WrongFieldForExpectedDocFiles extraDocFileSupport field paths) =
+    "Please consider moving the " ++ quotes paths
+      ++ " from the '" ++ field ++ "' section of the .cabal file "
+      ++ "to the section '" ++ targetField ++ "'."
+  where quotes [p] = "file " ++ quote p
+        quotes ps = "files " ++ intercalate ", " (map quote ps)
+        targetField = if extraDocFileSupport
+                        then "extra-doc-files"
+                        else "extra-source-files"
 
 
 -- | Results of some kind of failed package check.
@@ -2412,27 +2434,141 @@ checkGlobFiles :: Verbosity
                -> PackageDescription
                -> FilePath
                -> IO [PackageCheck]
-checkGlobFiles verbosity pkg root =
-  fmap concat $ for allGlobs $ \(field, dir, glob) ->
-    -- Note: we just skip over parse errors here; they're reported elsewhere.
-    case parseFileGlob (specVersion pkg) glob of
-      Left _ -> return []
-      Right parsedGlob -> do
-        results <- runDirFileGlob verbosity (root </> dir) parsedGlob
-        let individualWarnings = results >>= getWarning field glob
-            noMatchesWarning =
-              [ PackageDistSuspiciousWarn (GlobNoMatch field glob)
-              | all (not . suppressesNoMatchesWarning) results
-              ]
-        return (noMatchesWarning ++ individualWarnings)
+checkGlobFiles verbosity pkg root = do
+  -- Get the desirable doc files from package’s directory
+  rootContents <- System.Directory.getDirectoryContents root
+  docFiles0 <- filterM System.doesFileExist
+                       [ file
+                       | file <- rootContents
+                       , isDesirableExtraDocFile desirableDocFiles file
+                       ]
+  -- Check the globs
+  (warnings, unlisted) <- foldrM checkGlob ([], docFiles0) allGlobs
+
+  return $ if null unlisted
+    -- No missing desirable file
+    then warnings
+    -- Some missing desirable files
+    else warnings ++
+         let unlisted' = (root </>) <$> unlisted
+         in [ PackageDistSuspiciousWarn
+                (MissingExpectedDocFiles extraDocFilesSupport unlisted')
+            ]
   where
-    adjustedDataDir = if null (dataDir pkg) then "." else dataDir pkg
+    -- `extra-doc-files` is supported only from version 1.18
+    extraDocFilesSupport = specVersion pkg >= CabalSpecV1_18
+    adjustedDataDir = if null (dataDir pkg) then root else root </> dataDir pkg
+    -- Cabal fields with globs
+    allGlobs :: [(String, Bool, FilePath, FilePath)]
     allGlobs = concat
-      [ (,,) "extra-source-files" "." <$> extraSrcFiles pkg
-      , (,,) "extra-doc-files" "." <$> extraDocFiles pkg
-      , (,,) "data-files" adjustedDataDir <$> dataFiles pkg
+      [ (,,,) "extra-source-files" (not extraDocFilesSupport) root <$>
+        extraSrcFiles pkg
+      , (,,,) "extra-doc-files" True root <$> extraDocFiles pkg
+      , (,,,) "data-files" False adjustedDataDir <$> dataFiles pkg
       ]
 
+    -- For each field with globs (see allGlobs), look for:
+    -- • errors (missing directory, no match)
+    -- • omitted documentation files (changelog)
+    checkGlob :: (String, Bool, FilePath, FilePath)
+              -> ([PackageCheck], [FilePath])
+              -> IO ([PackageCheck], [FilePath])
+    checkGlob (field, isDocField, dir, glob) acc@(warnings, docFiles1) =
+      -- Note: we just skip over parse errors here; they're reported elsewhere.
+      case parseFileGlob (specVersion pkg) glob of
+        Left _ -> return acc
+        Right parsedGlob -> do
+          results <- runDirFileGlob verbosity (root </> dir) parsedGlob
+          let acc0 = (warnings, True, docFiles1, [])
+          return $ case foldr checkGlobResult acc0 results of
+            (individualWarn, noMatchesWarn, docFiles1', wrongPaths) ->
+              let wrongFieldWarnings = [ PackageDistSuspiciousWarn
+                                          (WrongFieldForExpectedDocFiles
+                                            extraDocFilesSupport
+                                            field wrongPaths)
+                                       | not (null wrongPaths) ]
+              in
+                ( if noMatchesWarn
+                    then [PackageDistSuspiciousWarn (GlobNoMatch field glob)] ++
+                         individualWarn ++
+                         wrongFieldWarnings
+                    else individualWarn ++ wrongFieldWarnings
+                , docFiles1'
+                )
+          where
+            checkGlobResult :: GlobResult FilePath
+                            -> ([PackageCheck], Bool, [FilePath], [FilePath])
+                            -> ([PackageCheck], Bool, [FilePath], [FilePath])
+            checkGlobResult result (ws, noMatchesWarn, docFiles2, wrongPaths) =
+              let noMatchesWarn' = noMatchesWarn &&
+                                   not (suppressesNoMatchesWarning result)
+              in case getWarning field glob result of
+                -- No match: add warning and do no further check
+                Left w ->
+                  ( w : ws
+                  , noMatchesWarn'
+                  , docFiles2
+                  , wrongPaths
+                  )
+                -- Match: check doc files
+                Right path ->
+                  let path' = makeRelative root (normalise path)
+                      (docFiles2', wrongPaths') = checkDoc isDocField
+                                                           path'
+                                                           docFiles2
+                                                           wrongPaths
+                  in
+                    ( ws
+                    , noMatchesWarn'
+                    , docFiles2'
+                    , wrongPaths'
+                    )
+
+    -- Check whether a path is a desirable doc: if so, check if it is in the
+    -- field "extra-doc-files".
+    checkDoc :: Bool                     -- Is it "extra-doc-files" ?
+             -> FilePath                 -- Path to test
+             -> [FilePath]               -- Pending doc files to check
+             -> [FilePath]               -- Previous wrong paths
+             -> ([FilePath], [FilePath]) -- Updated paths
+    checkDoc isDocField path docFiles wrongFieldPaths =
+      if path `elem` docFiles
+        -- Found desirable doc file
+        then
+          ( delete path docFiles
+          , if isDocField then wrongFieldPaths else path : wrongFieldPaths
+          )
+        -- Not a desirable doc file
+        else
+          ( docFiles
+          , wrongFieldPaths
+          )
+
+    -- Predicate for desirable documentation file on Hackage server
+    isDesirableExtraDocFile :: [FilePath] -> FilePath -> Bool
+    isDesirableExtraDocFile paths path = map toLower basename `elem` paths
+      where
+        (basename, _ext) = splitExtension path
+
+    -- Changelog patterns
+    -- Source: hackage-server/src/Distribution/Server/Packages/ChangeLog.hs
+    desirableChangeLog =
+      [ "news"
+      , "changelog"
+      , "change_log"
+      , "changes"
+      ]
+    -- [TODO] Check readme. Observations:
+    --        • Readme is not necessary if package description is good.
+    --        • Some readmes exists only for repository browsing.
+    --        • There is currently no reliable way to check what a good
+    --          description is; there will be complains if the criterion is
+    --          based on the length or number of words (can of worms).
+    -- -- Readme patterns
+    -- -- Source: hackage-server/src/Distribution/Server/Packages/Readme.hs
+    -- desirableReadme = ["readme"]
+    desirableDocFiles = desirableChangeLog
+
     -- If there's a missing directory in play, since our globs don't
     -- (currently) support disjunction, that will always mean there are no
     -- matches. The no matches error in this case is strictly less informative
@@ -2441,17 +2577,20 @@ checkGlobFiles verbosity pkg root =
     suppressesNoMatchesWarning (GlobWarnMultiDot _) = False
     suppressesNoMatchesWarning (GlobMissingDirectory _) = True
 
-    getWarning :: String -> FilePath -> GlobResult FilePath -> [PackageCheck]
-    getWarning _ _ (GlobMatch _) =
-      []
+    getWarning :: String
+               -> FilePath
+               -> GlobResult FilePath
+               -> Either PackageCheck FilePath
+    getWarning _ _ (GlobMatch path) =
+      Right path
     -- Before Cabal 2.4, the extensions of globs had to match the file
     -- exactly. This has been relaxed in 2.4 to allow matching only the
     -- suffix. This warning detects when pre-2.4 package descriptions are
     -- omitting files purely because of the stricter check.
     getWarning field glob (GlobWarnMultiDot file) =
-      [ PackageDistSuspiciousWarn (GlobExactMatch field glob file) ]
+      Left (PackageDistSuspiciousWarn (GlobExactMatch field glob file))
     getWarning field glob (GlobMissingDirectory dir) =
-      [ PackageDistSuspiciousWarn (GlobNoDir field glob dir) ]
+      Left (PackageDistSuspiciousWarn (GlobNoDir field glob dir))
 
 -- | Check that setup dependencies, have proper bounds.
 -- In particular, @base@ and @Cabal@ upper bounds are mandatory.

cabal-testsuite/PackageTests/Check/PackageFiles/MissingExpectedDocFiles/ChangeLog/NotExisting/cabal.out

@@ -0,0 +1,2 @@
+# cabal check
+No errors or warnings could be found in the package.

cabal-testsuite/PackageTests/Check/PackageFiles/MissingExpectedDocFiles/ChangeLog/NotExisting/cabal.test.hs

@@ -0,0 +1,7 @@
+import Test.Cabal.Prelude
+
+import System.Directory (createDirectoryIfMissing)
+
+-- Omitting ChangeLog.md but not README in extra-doc-files
+main = cabalTest $ do
+  cabal "check" []

cabal-testsuite/PackageTests/Check/PackageFiles/MissingExpectedDocFiles/ChangeLog/NotExisting/pkg.cabal

@@ -0,0 +1,12 @@
+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

cabal-testsuite/PackageTests/Check/PackageFiles/MissingExpectedDocFiles/ChangeLog/NotIncluded/V1.12/cabal.out

@@ -0,0 +1,3 @@
+# cabal check
+Warning: These warnings may cause trouble when distributing the package:
+Warning: Please consider including the file './ChangeLog.md' in the 'extra-source-files' section of the .cabal file if it contains useful information for users of the package.

cabal-testsuite/PackageTests/Check/PackageFiles/MissingExpectedDocFiles/ChangeLog/NotIncluded/V1.12/cabal.test.hs

@@ -0,0 +1,7 @@
+import Test.Cabal.Prelude
+
+import System.Directory (createDirectoryIfMissing)
+
+-- Omitting ChangeLog.md but not README in extra-doc-files
+main = cabalTest $ do
+  cabal "check" []

cabal-testsuite/PackageTests/Check/PackageFiles/MissingExpectedDocFiles/ChangeLog/NotIncluded/V1.12/pkg.cabal

@@ -0,0 +1,14 @@
+cabal-version: 1.12
+build-type: Simple
+name: pkg
+synopsis: synopsis
+description: description
+version: 0
+category: example
+maintainer: none@example.com
+license: GPL-3
+license-file: LICENSE
+
+library
+  exposed-modules: Foo
+  default-language: Haskell2010

cabal-testsuite/PackageTests/Check/PackageFiles/MissingExpectedDocFiles/ChangeLog/NotIncluded/V3.0/cabal.out

@@ -0,0 +1,3 @@
+# cabal check
+Warning: These warnings may cause trouble when distributing the package:
+Warning: Please consider including the file './ChangeLog.md' in the 'extra-doc-files' section of the .cabal file if it contains useful information for users of the package.

cabal-testsuite/PackageTests/Check/PackageFiles/MissingExpectedDocFiles/ChangeLog/NotIncluded/V3.0/cabal.test.hs

@@ -0,0 +1,7 @@
+import Test.Cabal.Prelude
+
+import System.Directory (createDirectoryIfMissing)
+
+-- Omitting ChangeLog.md but not README in extra-doc-files
+main = cabalTest $ do
+  cabal "check" []

cabal-testsuite/PackageTests/Check/PackageFiles/MissingExpectedDocFiles/ChangeLog/NotIncluded/V3.0/pkg.cabal

@@ -0,0 +1,12 @@
+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

cabal-testsuite/PackageTests/Check/PackageFiles/MissingExpectedDocFiles/ChangeLog/WrongField/V1.12/cabal.out

@@ -0,0 +1,3 @@
+# cabal check
+Warning: These warnings may cause trouble when distributing the package:
+Warning: Please consider moving the file 'ChangeLog.md' from the 'data-files' section of the .cabal file to the section 'extra-source-files'.

cabal-testsuite/PackageTests/Check/PackageFiles/MissingExpectedDocFiles/ChangeLog/WrongField/V1.12/cabal.test.hs

@@ -0,0 +1,7 @@
+import Test.Cabal.Prelude
+
+import System.Directory (createDirectoryIfMissing)
+
+-- Included ChangeLog.md but not in extra-doc-files
+main = cabalTest $ do
+  cabal "check" []

cabal-testsuite/PackageTests/Check/PackageFiles/MissingExpectedDocFiles/ChangeLog/WrongField/V1.12/pkg.cabal

@@ -0,0 +1,15 @@
+cabal-version: 1.12
+build-type: Simple
+name: pkg
+synopsis: synopsis
+description: description
+version: 0
+category: example
+maintainer: none@example.com
+license: GPL-3
+license-file: LICENSE
+data-files: ChangeLog.md
+
+library
+  exposed-modules: Foo
+  default-language: Haskell2010

cabal-testsuite/PackageTests/Check/PackageFiles/MissingExpectedDocFiles/ChangeLog/WrongField/V3.0/cabal.out

@@ -0,0 +1,3 @@
+# cabal check
+Warning: These warnings may cause trouble when distributing the package:
+Warning: Please consider moving the file 'ChangeLog.md' from the 'extra-source-files' section of the .cabal file to the section 'extra-doc-files'.

cabal-testsuite/PackageTests/Check/PackageFiles/MissingExpectedDocFiles/ChangeLog/WrongField/V3.0/cabal.test.hs

@@ -0,0 +1,7 @@
+import Test.Cabal.Prelude
+
+import System.Directory (createDirectoryIfMissing)
+
+-- Included ChangeLog.md but not in extra-doc-files
+main = cabalTest $ do
+  cabal "check" []

cabal-testsuite/PackageTests/Check/PackageFiles/MissingExpectedDocFiles/ChangeLog/WrongField/V3.0/pkg.cabal

@@ -0,0 +1,13 @@
+cabal-version: 3.0
+name: pkg
+synopsis: synopsis
+description: description
+version: 0
+category: example
+maintainer: none@example.com
+license: GPL-3.0-or-later
+extra-source-files: ChangeLog.md
+
+library
+  exposed-modules: Foo
+  default-language: Haskell2010

changelog.d/pr-8657

@@ -0,0 +1,13 @@
+synopsis: Warn if expected files are omitted from extra-doc-files
+packages: Cabal
+prs: #8657
+issues: #3964
+
+description: {
+
+- Emit a warning if there exist a “changelog” file at the root of the
+  package which is not included in any field.
+- Emit a warning if a “changelog” file at the root of the package is included 
+  in a field different from “extra-doc-files” (Cabal spec >= 1.18) or 
+  “extra-source-files” (spec < 1.18).
+}