Resolve #7124: sdist tells which package fails

Cabal/src/Distribution/Simple/Glob.hs

@@ -18,6 +18,7 @@ module Distribution.Simple.Glob (
         GlobSyntaxError(..),
         GlobResult(..),
         matchDirFileGlob,
+        matchDirFileGlobWithDie,
         runDirFileGlob,
         fileGlobMatches,
         parseFileGlob,
@@ -220,24 +221,37 @@ parseFileGlob version filepath = case reverse (splitDirectories filepath) of
 -- prefix.
 --
 -- The second 'FilePath' is the glob itself.
+--
 matchDirFileGlob :: Verbosity -> CabalSpecVersion -> FilePath -> FilePath -> IO [FilePath]
-matchDirFileGlob verbosity version dir filepath = case parseFileGlob version filepath of
-  Left err -> die' verbosity $ explainGlobSyntaxError filepath err
+matchDirFileGlob v = matchDirFileGlobWithDie v die'
+
+-- | Like 'matchDirFileGlob' but with customizable 'die'
+--
+-- @since 3.6.0.0
+--
+matchDirFileGlobWithDie :: Verbosity -> (Verbosity -> String -> IO [FilePath]) -> CabalSpecVersion -> FilePath -> FilePath -> IO [FilePath]
+matchDirFileGlobWithDie verbosity rip version dir filepath = case parseFileGlob version filepath of
+  Left err -> rip verbosity $ explainGlobSyntaxError filepath err
   Right glob -> do
     results <- runDirFileGlob verbosity dir glob
     let missingDirectories =
           [ missingDir | GlobMissingDirectory missingDir <- results ]
         matches = globMatches results
-    -- Check for missing directories first, since we'll obviously have
-    -- no matches in that case.
-    for_ missingDirectories $ \ missingDir ->
-      die' verbosity $
-           "filepath wildcard '" ++ filepath ++ "' refers to the directory"
-        ++ " '" ++ missingDir ++ "', which does not exist or is not a directory."
-    when (null matches) $ die' verbosity $
-         "filepath wildcard '" ++ filepath
-      ++ "' does not match any files."
-    return matches
+
+    let errors :: [String]
+        errors =
+            [ "filepath wildcard '" ++ filepath ++ "' refers to the directory"
+            ++ " '" ++ missingDir ++ "', which does not exist or is not a directory."
+            | missingDir <- missingDirectories
+            ]
+            ++
+            [ "filepath wildcard '" ++ filepath ++ "' does not match any files."
+            | null matches
+            ]
+
+    if null errors
+    then return matches
+    else rip verbosity $ unlines errors
 
 -- | Match files against a pre-parsed glob, starting in a directory.
 --

Cabal/src/Distribution/Simple/SrcDist.hs

@@ -54,7 +54,7 @@ import Distribution.ModuleName
 import qualified Distribution.ModuleName as ModuleName
 import Distribution.Version
 import Distribution.Simple.Configure (findDistPrefOrDefault)
-import Distribution.Simple.Glob
+import Distribution.Simple.Glob (matchDirFileGlobWithDie)
 import Distribution.Simple.Utils
 import Distribution.Simple.Setup
 import Distribution.Simple.PreProcess
@@ -223,16 +223,16 @@ listPackageSources' verbosity rip cwd pkg_descr pps =
         let srcDataDirRaw                   = dataDir pkg_descr
             srcDataDir | null srcDataDirRaw = "."
                        | otherwise          = srcDataDirRaw
-        matchDirFileGlob verbosity (specVersion pkg_descr) cwd (srcDataDir </> filename)
+        matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) cwd (srcDataDir </> filename)
 
     -- Extra source files.
   , fmap concat . for (extraSrcFiles pkg_descr) $ \fpath ->
-    matchDirFileGlob verbosity (specVersion pkg_descr) cwd fpath
+    matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) cwd fpath
 
     -- Extra doc files.
   , fmap concat
     . for (extraDocFiles pkg_descr) $ \ filename ->
-        matchDirFileGlob verbosity (specVersion pkg_descr) cwd filename
+        matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) cwd filename
 
     -- License file(s).
   , return (licenseFiles pkg_descr)

cabal-install/src/Distribution/Client/CmdSdist.hs

@@ -50,7 +50,7 @@ import Distribution.Simple.Setup
     , optionVerbosity, optionDistPref, trueArg, configVerbosity, configDistPref
     )
 import Distribution.Simple.SrcDist
-    ( listPackageSources )
+    ( listPackageSourcesWithDie )
 import Distribution.Client.SrcDist
     ( packageDirToSdist )
 import Distribution.Simple.Utils
@@ -61,6 +61,7 @@ import Distribution.Types.PackageName
     ( PackageName, unPackageName )
 import Distribution.Verbosity
     ( normal )
+import Distribution.Types.GenericPackageDescription (GenericPackageDescription)
 
 import qualified Data.ByteString.Lazy.Char8 as BSL
 import System.Directory
@@ -250,7 +251,13 @@ packageToSdist verbosity projectRootDir format outputFile pkg = do
 
       Right dir -> case format of
         SourceList nulSep -> do
-          files' <- listPackageSources verbosity dir (flattenPackageDescription $ srcpkgDescription pkg) knownSuffixHandlers
+          let gpd :: GenericPackageDescription
+              gpd = srcpkgDescription pkg
+
+          let thisDie :: Verbosity -> String -> IO a
+              thisDie v s = die' v $ "sdist of " <> prettyShow (packageId gpd) ++ ": " ++ s
+
+          files' <- listPackageSourcesWithDie verbosity thisDie dir (flattenPackageDescription gpd) knownSuffixHandlers
           let files = nub $ sort $ map normalise files'
           let prefix = makeRelative projectRootDir dir
           write $ concat [prefix </> i ++ [nulSep] | i <- files]

cabal-install/src/Distribution/Client/SrcDist.hs

@@ -18,7 +18,6 @@ import Distribution.Package                          (Package (packageId))
 import Distribution.PackageDescription.Configuration (flattenPackageDescription)
 import Distribution.PackageDescription.Parsec        (readGenericPackageDescription)
 import Distribution.Simple.PreProcess                (knownSuffixHandlers)
-import Distribution.Simple.SrcDist                   (listPackageSources)
 import Distribution.Simple.SrcDist                   (listPackageSourcesWithDie)
 import Distribution.Simple.Utils                     (die')
 import Distribution.Types.GenericPackageDescription  (GenericPackageDescription)
@@ -52,7 +51,10 @@ packageDirToSdist
     -> FilePath                   -- ^ directory containing that GPD
     -> IO BSL.ByteString          -- ^ resulting sdist tarball
 packageDirToSdist verbosity gpd dir = do
-    files' <- listPackageSources verbosity dir (flattenPackageDescription gpd) knownSuffixHandlers
+    let thisDie :: Verbosity -> String -> IO a
+        thisDie v s = die' v $ "sdist of " <> prettyShow (packageId gpd) ++ ": " ++ s
+
+    files' <- listPackageSourcesWithDie verbosity thisDie dir (flattenPackageDescription gpd) knownSuffixHandlers
     let files = nub $ sort $ map normalise files'
 
     let entriesM :: StateT (Set.Set FilePath) (WriterT [Tar.Entry] IO) ()

cabal-testsuite/PackageTests/SDist/T5195/cabal.out

 # cabal v2-sdist
-cabal: filepath wildcard './actually-a-directory' does not match any files.
+cabal: sdist of t5195-0: filepath wildcard './actually-a-directory' does not match any files.

cabal-testsuite/PackageTests/SDist/T7124/cabal-list.out

+# cabal v2-sdist
+Wrote source list to <TMPDIR>/pkg-a-0.list
+cabal: sdist of pkg-b-0: filepath wildcard './data.txt' does not match any files.

cabal-testsuite/PackageTests/SDist/T7124/cabal-list.test.hs

+import Test.Cabal.Prelude
+
+-- Issue 7124
+-- when we sdist, error should tell which package caused the failure
+
+main :: IO ()
+main = cabalTest $ do
+  tmpdir <- fmap testTmpDir getTestEnv
+  fails $ cabal "v2-sdist" ["--ignore-project", "--list-only", "--output-directory", tmpdir, "all"]

cabal-testsuite/PackageTests/SDist/T7124/cabal.out

+# cabal v2-sdist
+Wrote tarball sdist to <TMPDIR>/pkg-a-0.tar.gz
+cabal: sdist of pkg-b-0: filepath wildcard './data.txt' does not match any files.

cabal-testsuite/PackageTests/SDist/T7124/cabal.project

+packages: pkg-a/*.cabal
+packages: pkg-b/*.cabal

cabal-testsuite/PackageTests/SDist/T7124/cabal.test.hs

+import Test.Cabal.Prelude
+
+-- Issue 7124
+-- when we sdist, error should tell which package caused the failure
+
+main :: IO ()
+main = cabalTest $ do
+  tmpdir <- fmap testTmpDir getTestEnv
+  fails $ cabal "v2-sdist" ["--ignore-project", "--output-directory", tmpdir, "all"]

cabal-testsuite/PackageTests/SDist/T7124/pkg-a/Main.hs

+main = putStrLn "hi"

cabal-testsuite/PackageTests/SDist/T7124/pkg-a/data.txt

+Lorem Ipsum

cabal-testsuite/PackageTests/SDist/T7124/pkg-a/pkg-a.cabal

+cabal-version: 2.2
+name: pkg-a
+version: 0
+
+data-files: data.txt
+
+executable foo
+  default-language: Haskell2010
+  main-is: Main.hs

cabal-testsuite/PackageTests/SDist/T7124/pkg-b/Main.hs

+main = putStrLn "hi"

cabal-testsuite/PackageTests/SDist/T7124/pkg-b/pkg-b.cabal

+cabal-version: 2.2
+name: pkg-b
+version: 0
+
+data-files: data.txt
+
+executable foo
+  default-language: Haskell2010
+  main-is: Main.hs