Add check for recursive glob in root directory (#8441)

* Add check for recursive glob in root directory

Such globs might be expensive to include, as they might pull unnecessary
 directories just like `.git` or `dist-newstyle`.

* Move expensive glob warning to its own constructor

* Add changelog entry

* Add test for recursive glob warning

* Fix formatting

Cabal/src/Distribution/PackageDescription/Check.hs

@@ -196,6 +196,7 @@ data CheckExplanation =
         | BadRelativePAth String FilePath String
         | DistPoint (Maybe String) FilePath
         | GlobSyntaxError String String
+        | RecursiveGlobInRoot String FilePath
         | InvalidOnWin [FilePath]
         | FilePathTooLong FilePath
         | FilePathNameTooLong FilePath
@@ -532,6 +533,10 @@ ppExplanation (DistPoint mfield path) =
                         mfield
 ppExplanation (GlobSyntaxError field expl) =
     "In the '" ++ field ++ "' field: " ++ expl
+ppExplanation (RecursiveGlobInRoot field glob) =
+    "In the '" ++ field ++ "': glob '" ++ glob
+    ++ "' starts at project root directory, this might "
+    ++ "include `.git/`, ``dist-newstyle/``, or other large directories!"
 ppExplanation (InvalidOnWin paths) =
     "The " ++ quotes paths ++ " invalid on Windows, which "
       ++ "would cause portability problems for this package. Windows file "
@@ -1601,20 +1606,35 @@ checkPaths pkg =
   ++
   [ PackageDistInexcusable $
       GlobSyntaxError "data-files" (explainGlobSyntaxError pat err)
-  | pat <- dataFiles pkg
-  , Left err <- [parseFileGlob (specVersion pkg) pat]
+  | (Left err, pat) <- zip globsDataFiles $ dataFiles pkg
   ]
   ++
   [ PackageDistInexcusable
       (GlobSyntaxError "extra-source-files" (explainGlobSyntaxError pat err))
-  | pat <- extraSrcFiles pkg
-  , Left err <- [parseFileGlob (specVersion pkg) pat]
+  | (Left err, pat) <- zip globsExtraSrcFiles $ extraSrcFiles pkg
   ]
   ++
   [ PackageDistInexcusable $
       GlobSyntaxError "extra-doc-files" (explainGlobSyntaxError pat err)
-  | pat <- extraDocFiles pkg
-  , Left err <- [parseFileGlob (specVersion pkg) pat]
+  | (Left err, pat) <- zip globsExtraDocFiles $ extraDocFiles pkg
+  ]
+  ++
+  [ PackageDistSuspiciousWarn $
+      RecursiveGlobInRoot "data-files" pat
+  | (Right glob, pat) <- zip globsDataFiles $ dataFiles pkg
+  , isRecursiveInRoot glob
+  ]
+  ++
+  [ PackageDistSuspiciousWarn $
+      RecursiveGlobInRoot "extra-source-files" pat
+  | (Right glob, pat) <- zip globsExtraSrcFiles $ extraSrcFiles pkg
+  , isRecursiveInRoot glob
+  ]
+  ++
+  [ PackageDistSuspiciousWarn $
+      RecursiveGlobInRoot "extra-doc-files" pat
+  | (Right glob, pat) <- zip globsExtraDocFiles $ extraDocFiles pkg
+  , isRecursiveInRoot glob
   ]
   where
     isOutsideTree path = case splitDirectories path of
@@ -1655,6 +1675,12 @@ checkPaths pkg =
         [ (path, "extra-lib-dirs-static", PathKindDirectory) | path <- extraLibDirsStatic bi ]
       | bi <- allBuildInfo pkg
       ]
+    globsDataFiles :: [Either GlobSyntaxError Glob]
+    globsDataFiles =  parseFileGlob (specVersion pkg) <$> dataFiles pkg
+    globsExtraSrcFiles :: [Either GlobSyntaxError Glob]
+    globsExtraSrcFiles =  parseFileGlob (specVersion pkg) <$> extraSrcFiles pkg
+    globsExtraDocFiles :: [Either GlobSyntaxError Glob]
+    globsExtraDocFiles =  parseFileGlob (specVersion pkg) <$> extraDocFiles pkg
 
 --TODO: check sets of paths that would be interpreted differently between Unix
 -- and windows, ie case-sensitive or insensitive. Things that might clash, or

Cabal/src/Distribution/Simple/Glob.hs

@@ -23,6 +23,7 @@ module Distribution.Simple.Glob (
         fileGlobMatches,
         parseFileGlob,
         explainGlobSyntaxError,
+        isRecursiveInRoot,
         Glob,
   ) where
 
@@ -336,3 +337,8 @@ splitConstantPrefix = unfoldr' step
   where
     step (GlobStem seg pat) = Right (seg, pat)
     step (GlobFinal pat) = Left pat
+
+
+isRecursiveInRoot :: Glob -> Bool
+isRecursiveInRoot (GlobFinal (FinalMatch Recursive _ _))  = True
+isRecursiveInRoot _ = False

cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/RecursiveGlobInRoot/cabal.out

@@ -0,0 +1,11 @@
+# cabal check
+Warning: These warnings may cause trouble when distributing the package:
+Warning: In the 'data-files': glob '**/*.dat' starts at project root
+directory, this might include `.git/`, ``dist-newstyle/``, or other large
+directories!
+Warning: In the 'extra-source-files': glob '**/*.hs' starts at project root
+directory, this might include `.git/`, ``dist-newstyle/``, or other large
+directories!
+Warning: In the 'extra-doc-files': glob '**/*.md' starts at project root
+directory, this might include `.git/`, ``dist-newstyle/``, or other large
+directories!

cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/RecursiveGlobInRoot/cabal.test.hs

@@ -0,0 +1,4 @@
+import Test.Cabal.Prelude
+
+main = cabalTest $
+  cabal "check" []

cabal-testsuite/PackageTests/Check/ConfiguredPackage/Paths/RecursiveGlobInRoot/pkg.cabal

@@ -0,0 +1,19 @@
+cabal-version: 3.8
+name: pkg
+version: 0
+extra-source-files:
+  **/*.hs
+data-files:
+  **/*.dat
+extra-doc-files:
+  **/*.md
+license: BSD-3-Clause
+synopsis: no
+description: none
+category: Test
+maintainer: none
+
+library
+  default-language: Haskell2010
+  exposed-modules:
+    Foo

changelog.d/pr-8441

@@ -0,0 +1,10 @@
+synopsis: Add warning about expensive globs
+packages: Cabal
+prs: #8441
+issues: #5311
+description: {
+
+- Now cabal check will emit a warning when package uses 
+recursive globs starting at root of the project
+
+}