New extra-files for adding neutral fields to sdist

The new extra-files field provides a way to specify extra files that should be included in sdist, without adding any other semantics (cf. extra-source-files are tracked by 'cabal build'). Resolves haskell#8817.
tbidne · Jun 12, 2024 · f322049 · f322049
1 parent dda541c
commit f322049
Show file tree

Hide file tree

Showing 12 changed files with 59 additions and 4 deletions.
diff --git a/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs b/Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
@@ -143,6 +143,7 @@ packageDescriptionFieldGrammar =
  <*> monoidalFieldAla "extra-source-files" formatExtraSourceFiles L.extraSrcFiles
  <*> monoidalFieldAla "extra-tmp-files" (alaList' VCat RelativePathNT) L.extraTmpFiles
  <*> monoidalFieldAla "extra-doc-files" formatExtraSourceFiles L.extraDocFiles
+ <*> monoidalFieldAla "extra-files" formatExtraSourceFiles L.extraFiles
  where
  packageIdentifierGrammar =
  PackageIdentifier

diff --git a/Cabal-syntax/src/Distribution/Types/PackageDescription.hs b/Cabal-syntax/src/Distribution/Types/PackageDescription.hs
@@ -149,6 +149,7 @@ data PackageDescription = PackageDescription
  , extraSrcFiles :: [RelativePath Pkg File]
  , extraTmpFiles :: [RelativePath Pkg File]
  , extraDocFiles :: [RelativePath Pkg File]
+ , extraFiles :: [RelativePath Pkg File]
  }
  deriving (Generic, Show, Read, Eq, Ord, Typeable, Data)
 
@@ -235,6 +236,7 @@ emptyPackageDescription =
  , extraSrcFiles = []
  , extraTmpFiles = []
  , extraDocFiles = []
+ , extraFiles = []
  }
 
 -- ---------------------------------------------------------------------------
@@ -491,6 +493,7 @@ instance L.HasBuildInfos PackageDescription where
  a22
  a23
  a24
+ a25
  ) =
  PackageDescription a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19
  <$> (traverse . L.buildInfo) f x1 -- library
@@ -504,3 +507,4 @@ instance L.HasBuildInfos PackageDescription where
  <*> pure a22 -- extra src files
  <*> pure a23 -- extra temp files
  <*> pure a24 -- extra doc files
+ <*> pure a25 -- extra files
diff --git a/Cabal-syntax/src/Distribution/Types/PackageDescription/Lens.hs b/Cabal-syntax/src/Distribution/Types/PackageDescription/Lens.hs
@@ -159,6 +159,10 @@ extraDocFiles :: Lens' PackageDescription [RelativePath Pkg File]
 extraDocFiles f s = fmap (\x -> s{T.extraDocFiles = x}) (f (T.extraDocFiles s))
 {-# INLINE extraDocFiles #-}
 
+extraFiles :: Lens' PackageDescription [RelativePath Pkg File]
+extraFiles f s = fmap (\x -> s{T.extraFiles = x}) (f (T.extraFiles s))
+{-# INLINE extraFiles #-}
+
 -- | @since 3.0.0.0
 allLibraries :: Traversal' PackageDescription Library
 allLibraries f pd = mk <$> traverse f (T.library pd) <*> traverse f (T.subLibraries pd)

diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs
@@ -409,6 +409,7 @@ checkPackageDescription
  extraSrcFiles_
  extraTmpFiles_
  extraDocFiles_
+ extraFiles_
  ) = do
  -- § Sanity checks.
  checkPackageId package_
@@ -456,6 +457,7 @@ checkPackageDescription
  mapM_ (checkPath False "extra-source-files" PathKindGlob . getSymbolicPath) extraSrcFiles_
  mapM_ (checkPath False "extra-tmp-files" PathKindFile . getSymbolicPath) extraTmpFiles_
  mapM_ (checkPath False "extra-doc-files" PathKindGlob . getSymbolicPath) extraDocFiles_
+ mapM_ (checkPath False "extra-files" PathKindGlob . getSymbolicPath) extraFiles_
  mapM_ (checkPath False "data-files" PathKindGlob . getSymbolicPath) dataFiles_
  let rawDataDir = getSymbolicPath dataDir_
  checkPath True "data-dir" PathKindDirectory rawDataDir
@@ -465,15 +467,17 @@ checkPackageDescription
 
  -- § Globs.
  dataGlobs <- mapM (checkGlob "data-files" . getSymbolicPath) dataFiles_
- extraGlobs <- mapM (checkGlob "extra-source-files" . getSymbolicPath) extraSrcFiles_
+ extraSrcGlobs <- mapM (checkGlob "extra-source-files" . getSymbolicPath) extraSrcFiles_
  docGlobs <- mapM (checkGlob "extra-doc-files" . getSymbolicPath) extraDocFiles_
+ extraGlobs <- mapM (checkGlob "extra-files" . getSymbolicPath) extraFiles_
  -- We collect globs to feed them to checkMissingDocs.
 
  -- § Missing documentation.
  checkMissingDocs
  (catMaybes dataGlobs)
- (catMaybes extraGlobs)
+ (catMaybes extraSrcGlobs)
  (catMaybes docGlobs)
+ (catMaybes extraGlobs)
 
  -- § Datafield checks.
  checkSetupBuildInfo setupBuildInfo_
@@ -519,6 +523,7 @@ checkPackageDescription
  checkCabalFile (packageName pkg)
  mapM_ (checkGlobFile specVersion_ "." "extra-source-files" . getSymbolicPath) extraSrcFiles_
  mapM_ (checkGlobFile specVersion_ "." "extra-doc-files" . getSymbolicPath) extraDocFiles_
+ mapM_ (checkGlobFile specVersion_ "." "extra-files" . getSymbolicPath) extraFiles_
  mapM_ (checkGlobFile specVersion_ rawDataDir "data-files" . getSymbolicPath) dataFiles_
  where
  checkNull
@@ -985,8 +990,9 @@ checkMissingDocs
  => [Glob] -- data-files globs.
  -> [Glob] -- extra-source-files globs.
  -> [Glob] -- extra-doc-files globs.
+ -> [Glob] -- extra-files globs.
  -> CheckM m ()
-checkMissingDocs dgs esgs edgs = do
+checkMissingDocs dgs esgs edgs efgs = do
  extraDocSupport <- (>= CabalSpecV1_18) <$> asksCM ccSpecVersion
 
  -- Everything in this block uses CheckPreDistributionOps interface.
@@ -1005,9 +1011,10 @@ checkMissingDocs dgs esgs edgs = do
  rgs <- realGlob dgs
  res <- realGlob esgs
  red <- realGlob edgs
+ ref <- realGlob efgs
 
  -- 3. Check if anything in 1. is missing in 2.
- let mcs = checkDoc extraDocSupport des (rgs ++ res ++ red)
+ let mcs = checkDoc extraDocSupport des (rgs ++ res ++ red ++ ref)
 
  -- 4. Check if files are present but in the wrong field.
  let pcsData = checkDocMove extraDocSupport "data-files" des rgs

diff --git a/Cabal/src/Distribution/Simple/SrcDist.hs b/Cabal/src/Distribution/Simple/SrcDist.hs
@@ -264,6 +264,10 @@ listPackageSources' verbosity rip mbWorkDir pkg_descr pps =
  $ \filename ->
  fmap (coerceSymbolicPath . relativeSymbolicPath)
  <$> matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) mbWorkDir filename
+ , -- Extra files.
+ fmap concat . for (extraFiles pkg_descr) $ \fpath ->
+ fmap relativeSymbolicPath
+ <$> matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) mbWorkDir fpath
  , -- License file(s).
  return (map (relativeSymbolicPath . coerceSymbolicPath) $ licenseFiles pkg_descr)
  , -- Install-include files, without autogen-include files

diff --git a/cabal-testsuite/PackageTests/SDist/T8817/cabal.out b/cabal-testsuite/PackageTests/SDist/T8817/cabal.out
@@ -0,0 +1,2 @@
+# cabal v2-sdist
+Wrote source list to <ROOT>/t8817-0.list
diff --git a/cabal-testsuite/PackageTests/SDist/T8817/cabal.test.hs b/cabal-testsuite/PackageTests/SDist/T8817/cabal.test.hs
@@ -0,0 +1,18 @@
+import Test.Cabal.Prelude
+
+main = cabalTest $ do
+ tmpdir <- fmap testTmpDir getTestEnv
+
+ cabal "v2-sdist" ["--output-directory", tmpdir, "all"]
+
+ let distDir = tmpdir </> "dist-newstyle" </> "sdist"
+ distExtractedPath = distDir </> "t8817"
+ distTarPath = distDir </> "t8817.tar.gz"
+
+ shouldExist distTarPath
+
+ tar ["xzf", distTarPath]
+
+ shouldExist (distTarPath </> "f1")
+ shouldExist (distTarPath </> "d1" </> "f2")
+ shouldExist (distTarPath </> "d1" </> "f3")
diff --git a/cabal-testsuite/PackageTests/SDist/T8817/pkg/Main.hs b/cabal-testsuite/PackageTests/SDist/T8817/pkg/Main.hs
@@ -0,0 +1 @@
+main = putStrLn "hi"
diff --git a/cabal-testsuite/PackageTests/SDist/T8817/pkg/d1/f2 b/cabal-testsuite/PackageTests/SDist/T8817/pkg/d1/f2
@@ -0,0 +1 @@
+f2
diff --git a/cabal-testsuite/PackageTests/SDist/T8817/pkg/d1/f3 b/cabal-testsuite/PackageTests/SDist/T8817/pkg/d1/f3
@@ -0,0 +1 @@
+f3
diff --git a/cabal-testsuite/PackageTests/SDist/T8817/pkg/f1 b/cabal-testsuite/PackageTests/SDist/T8817/pkg/f1
@@ -0,0 +1 @@
+f1
diff --git a/cabal-testsuite/PackageTests/SDist/T8817/pkg/t8817.cabal b/cabal-testsuite/PackageTests/SDist/T8817/pkg/t8817.cabal
@@ -0,0 +1,11 @@
+cabal-version: 2.2
+name: t8817
+version: 0
+
+extra-files:
+ d1/*
+ f1
+
+executable foo
+ default-language: Haskell2010
+ main-is: Main.hs