Merge the two Globbing modules in cabal and cabal-install

We use the datatype representation from the globbing in cabal-install,
but preserve a standalone parser for globs present in cabal files, whose
specification is constrained by the cabal specification. The
implementations are merged taking the best parts of each.

We also make sure sdist is robust to accidentally-listed directories,
as the refactor of the globbing modules re-uncovered this issue, and
required a prompt fix for the refactor not to break some things.

Fixes #5349

Cabal-tests/tests/UnitTests/Distribution/Simple/Glob.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 module UnitTests.Distribution.Simple.Glob
     ( tests
     ) where
@@ -54,7 +55,7 @@ compatibilityTests version =
   [ testCase "literal match" $
       testMatches "foo/a" [GlobMatch "foo/a"]
   , testCase "literal no match on prefix" $
-      testMatches "foo/c.html" []
+      testMatches "foo/c.html" [GlobMatchesDirectory "foo/c.html"]
   , testCase "literal no match on suffix" $
       testMatches "foo/a.html" [GlobMatch "foo/a.html"]
   , testCase "literal no prefix" $
@@ -64,7 +65,7 @@ compatibilityTests version =
   , testCase "glob" $
       testMatches "*.html" [GlobMatch "a.html", GlobMatch "b.html"]
   , testCase "glob in subdir" $
-      testMatches "foo/*.html" [GlobMatch "foo/a.html", GlobMatch "foo/b.html"]
+      testMatches "foo/*.html" [GlobMatchesDirectory "foo/c.html", GlobMatch "foo/b.html", GlobMatch "foo/a.html"]
   , testCase "glob multiple extensions" $
       testMatches "foo/*.html.gz" [GlobMatch "foo/a.html.gz", GlobMatch "foo/b.html.gz"]
   , testCase "glob in deep subdir" $
@@ -101,13 +102,16 @@ testMatchesVersion version pat expected = do
   where
     isEqual = (==) `on` (sort . fmap (fmap normalise))
     checkPure globPat = do
-      let actual = mapMaybe (fileGlobMatches globPat) sampleFileNames
-      unless (sort expected == sort actual) $
+      let actual = mapMaybe (\p -> (p <$) <$> fileGlobMatches version globPat p) sampleFileNames
+          -- We drop directory matches from the expected results since the pure
+          -- check can't identify that kind of match.
+          expected' = filter (\case GlobMatchesDirectory _ -> False; _ -> True) expected
+      unless (sort expected' == sort actual) $
         assertFailure $ "Unexpected result (pure matcher): " ++ show actual
     checkIO globPat =
       withSystemTempDirectory "globstar-sample" $ \tmpdir -> do
         makeSampleFiles tmpdir
-        actual <- runDirFileGlob Verbosity.normal tmpdir globPat
+        actual <- runDirFileGlob Verbosity.normal (Just version) tmpdir globPat
         unless (isEqual actual expected) $
           assertFailure $ "Unexpected result (impure matcher): " ++ show actual
 

Cabal/Cabal.cabal

@@ -105,6 +105,7 @@ library
     Distribution.Simple.GHCJS
     Distribution.Simple.Haddock
     Distribution.Simple.Glob
+    Distribution.Simple.Glob.Internal
     Distribution.Simple.HaskellSuite
     Distribution.Simple.Hpc
     Distribution.Simple.Install

Cabal/src/Distribution/PackageDescription/Check.hs

@@ -61,9 +61,20 @@ import Distribution.PackageDescription.Check.Warning
 import Distribution.Parsec.Warning (PWarning)
 import Distribution.Pretty (prettyShow)
 import Distribution.Simple.Glob
+  ( Glob
+  , GlobResult (..)
+  , globMatches
+  , parseFileGlob
+  , runDirFileGlob
+  )
 import Distribution.Simple.Utils hiding (findPackageDesc, notice)
 import Distribution.Utils.Generic (isAscii)
 import Distribution.Utils.Path
+  ( LicenseFile
+  , PackageDir
+  , SymbolicPath
+  , getSymbolicPath
+  )
 import Distribution.Verbosity
 import Distribution.Version
 import System.FilePath (splitExtension, takeFileName, (<.>), (</>))
@@ -170,7 +181,7 @@ checkPackageFilesGPD verbosity gpd root =
 
     checkPreIO =
       CheckPreDistributionOps
-        { runDirFileGlobM = \fp g -> runDirFileGlob verbosity (root </> fp) g
+        { runDirFileGlobM = \fp g -> runDirFileGlob verbosity (Just . specVersion $ packageDescription gpd) (root </> fp) g
         , getDirectoryContentsM = System.Directory.getDirectoryContents . relative
         }
 
@@ -853,13 +864,14 @@ checkGlobResult title fp rs = dirCheck ++ catMaybes (map getWarning rs)
           [PackageDistSuspiciousWarn $ GlobNoMatch title fp]
       | otherwise = []
 
-    -- If there's a missing directory in play, since our globs don't
-    -- (currently) support disjunction, that will always mean there are
+    -- If there's a missing directory in play, since globs in Cabal packages
+    -- don't (currently) support disjunction, that will always mean there are
     -- no matches. The no matches error in this case is strictly less
     -- informative than the missing directory error.
     withoutNoMatchesWarning (GlobMatch _) = True
     withoutNoMatchesWarning (GlobWarnMultiDot _) = False
     withoutNoMatchesWarning (GlobMissingDirectory _) = True
+    withoutNoMatchesWarning (GlobMatchesDirectory _) = True
 
     getWarning :: GlobResult FilePath -> Maybe PackageCheck
     getWarning (GlobMatch _) = Nothing
@@ -871,6 +883,9 @@ checkGlobResult title fp rs = dirCheck ++ catMaybes (map getWarning rs)
       Just $ PackageDistSuspiciousWarn (GlobExactMatch title fp file)
     getWarning (GlobMissingDirectory dir) =
       Just $ PackageDistSuspiciousWarn (GlobNoDir title fp dir)
+    -- GlobMatchesDirectory is handled elsewhere if relevant;
+    -- we can discard it here.
+    getWarning (GlobMatchesDirectory _) = Nothing
 
 -- ------------------------------------------------------------
 -- Other exports
@@ -1012,10 +1027,6 @@ checkMissingDocs dgs esgs edgs = do
         return (mcs ++ pcs)
     )
   where
-    -- From Distribution.Simple.Glob.
-    globMatches :: [GlobResult a] -> [a]
-    globMatches input = [a | GlobMatch a <- input]
-
     checkDoc
       :: Bool -- Cabal spec ≥ 1.18?
       -> [FilePath] -- Desirables.

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

@@ -24,6 +24,11 @@ import Distribution.PackageDescription.Check.Common
 import Distribution.PackageDescription.Check.Monad
 import Distribution.Simple.CCompiler
 import Distribution.Simple.Glob
+  ( Glob
+  , explainGlobSyntaxError
+  , isRecursiveInRoot
+  , parseFileGlob
+  )
 import Distribution.Simple.Utils hiding (findPackageDesc, notice)
 import System.FilePath (splitDirectories, splitPath, takeExtension)