Create source archives by running 'setup sdist --output-directory'.

Fixes #403.

Author: 23Skidoo

Cabal/Distribution/Simple/SrcDist.hs

@@ -54,10 +54,6 @@ module Distribution.Simple.SrcDist (
   -- * The top level action
   sdist,
 
-  -- * Actual implemenation of 'sdist', for reuse by 'cabal sdist'
-  CreateArchiveFun,
-  sdistWith,
-
   -- ** Parts of 'sdist'
   printPackageProblems,
   prepareTree,
@@ -123,26 +119,15 @@ sdist :: PackageDescription     -- ^information from the tarball
       -> [PPSuffixHandler]      -- ^ extra preprocessors (includes suffixes)
       -> IO ()
 sdist pkg mb_lbi flags mkTmpDir pps =
-  sdistWith pkg mb_lbi flags mkTmpDir pps createArchive
-
--- |Create a source distribution, parametrised by the createArchive function
--- (for reuse by cabal-install).
-sdistWith :: PackageDescription        -- ^information from the tarball
-             -> Maybe LocalBuildInfo   -- ^Information from configure
-             -> SDistFlags             -- ^verbosity & snapshot
-             -> (FilePath -> FilePath) -- ^build prefix (temp dir)
-             -> [PPSuffixHandler]      -- ^extra preprocessors (includes
-                                       -- suffixes)
-             -> CreateArchiveFun
-             -> IO ()
-sdistWith pkg mb_lbi flags mkTmpDir pps createArchiveFun = do
 
   -- When given --list-sources, just output the list of sources to a file.
   case (sDistListSources flags) of
     Flag path -> withFile path WriteMode $ \outHandle -> do
       (ordinary, maybeExecutable) <- listPackageSources verbosity pkg pps
       mapM_ (hPutStrLn outHandle) ordinary
       mapM_ (hPutStrLn outHandle) maybeExecutable
+      notice verbosity $ "List of package sources written to file '"
+                         ++ path ++ "'"
     NoFlag    -> do
       -- do some QA
       printPackageProblems verbosity pkg
@@ -164,7 +149,7 @@ sdistWith pkg mb_lbi flags mkTmpDir pps createArchiveFun = do
           withTempDirectory verbosity False tmpTargetDir "sdist." $ \tmpDir -> do
             let targetDir = tmpDir </> tarBallName pkg'
             generateSourceDir targetDir pkg'
-            targzFile <- createArchiveFun verbosity pkg' mb_lbi tmpDir targetPref
+            targzFile <- createArchive verbosity pkg' mb_lbi tmpDir targetPref
             notice verbosity $ "Source tarball created: " ++ targzFile
 
   where

cabal-install/Distribution/Client/SrcDist.hs

@@ -6,31 +6,31 @@ module Distribution.Client.SrcDist (
   )  where
 
 
-import Distribution.Simple.SrcDist
-         ( CreateArchiveFun, sdistWith )
+import Distribution.Client.SetupWrapper
+        ( SetupScriptOptions(..), defaultSetupScriptOptions, setupWrapper )
 import Distribution.Client.Tar (createTarGzFile)
 
 import Distribution.Package
          ( Package(..) )
 import Distribution.PackageDescription
          ( PackageDescription )
+import Distribution.PackageDescription.Configuration
+         ( flattenPackageDescription )
 import Distribution.PackageDescription.Parse
          ( readPackageDescription )
 import Distribution.Simple.Utils
-         ( defaultPackageDesc, die )
+         ( createDirectoryIfMissingVerbose, defaultPackageDesc
+         , die, notice, withTempDirectory )
 import Distribution.Client.Setup
          ( SDistFlags(..), SDistExFlags(..), ArchiveFormat(..) )
 import Distribution.Simple.Setup
-         ( fromFlag )
-import Distribution.Simple.PreProcess (knownSuffixHandlers)
+         ( Flag(..), sdistCommand, flagToList, fromFlag, fromFlagOrDefault )
 import Distribution.Simple.BuildPaths ( srcPref)
-import Distribution.Simple.Configure(maybeGetPersistBuildConfig)
-import Distribution.PackageDescription.Configuration
-         ( flattenPackageDescription )
 import Distribution.Simple.Program (requireProgram, simpleProgram, programPath)
 import Distribution.Simple.Program.Db (emptyProgramDb)
-import Distribution.Text
-         ( display )
+import Distribution.Text ( display )
+import Distribution.Verbosity (Verbosity)
+import Distribution.Version   (Version(..), orLaterVersion)
 
 import System.FilePath ((</>), (<.>))
 import Control.Monad (when, unless)
@@ -42,15 +42,42 @@ import System.Exit    (ExitCode(..))
 sdist :: SDistFlags -> SDistExFlags -> IO ()
 sdist flags exflags = do
   pkg <- return . flattenPackageDescription
-     =<< readPackageDescription verbosity
-     =<< defaultPackageDesc verbosity
-  mb_lbi <- maybeGetPersistBuildConfig distPref
+         =<< readPackageDescription verbosity
+         =<< defaultPackageDesc verbosity
+  let withDir = if isOutDirectory then (\f -> f tmpTargetDir)
+                else withTempDirectory verbosity False tmpTargetDir "sdist."
+  -- Otherwise 'withTempDir' fails...
+  createDirectoryIfMissingVerbose verbosity True tmpTargetDir
+  withDir $ \tmpDir -> do
+    let outDir = if isOutDirectory then tmpDir else tmpDir </> tarBallName pkg
+        flags' = if isOutDirectory then flags
+                 else flags { sDistDirectory = Flag outDir }
 
-  sdistWith pkg mb_lbi flags srcPref knownSuffixHandlers createArchive
+    createDirectoryIfMissingVerbose verbosity True outDir
+
+    -- Run 'setup sdist --output-directory=tmpDir'
+    setupWrapper verbosity setupOpts (Just pkg) sdistCommand (const flags') []
+
+    -- And unless we were given --list-sources or --output-directory ourselves,
+    -- create an archive.
+    unless (isListSources || isOutDirectory) $
+      createArchive verbosity pkg tmpDir distPref
 
   where
-    verbosity     = fromFlag (sDistVerbosity flags)
-    distPref      = fromFlag (sDistDistPref flags)
+    flagEnabled f  = not . null . flagToList . f $ flags
+
+    isListSources  = flagEnabled sDistListSources
+    isOutDirectory = flagEnabled sDistDirectory
+    verbosity      = fromFlag (sDistVerbosity flags)
+    distPref       = fromFlag (sDistDistPref flags)
+    tmpTargetDir   = fromFlagOrDefault (srcPref distPref) (sDistDirectory flags)
+    setupOpts      = defaultSetupScriptOptions {
+      -- The '--output-directory' sdist flag was introduced in Cabal 1.12, and
+      -- '--list-sources' in 1.17.
+      useCabalVersion = if isListSources
+                        then orLaterVersion $ Version [1,17,0] []
+                        else orLaterVersion $ Version [1,12,0] []
+      }
     format        = fromFlag (sDistFormat exflags)
     createArchive = case format of
       TargzFormat -> createTarGzArchive
@@ -60,16 +87,18 @@ tarBallName :: PackageDescription -> String
 tarBallName = display . packageId
 
 -- | Create a tar.gz archive from a tree of source files.
-createTarGzArchive :: CreateArchiveFun
-createTarGzArchive _verbosity pkg _mlbi tmpDir targetPref = do
+createTarGzArchive :: Verbosity -> PackageDescription -> FilePath -> FilePath
+                    -> IO ()
+createTarGzArchive verbosity pkg tmpDir targetPref = do
     createTarGzFile tarBallFilePath tmpDir (tarBallName pkg)
-    return tarBallFilePath
+    notice verbosity $ "Source tarball created: " ++ tarBallFilePath
   where
     tarBallFilePath = targetPref </> tarBallName pkg <.> "tar.gz"
 
 -- | Create a zip archive from a tree of source files.
-createZipArchive :: CreateArchiveFun
-createZipArchive verbosity pkg _mlbi tmpDir targetPref = do
+createZipArchive :: Verbosity -> PackageDescription -> FilePath -> FilePath
+                    -> IO ()
+createZipArchive verbosity pkg tmpDir targetPref = do
     let dir       = tarBallName pkg
         zipfile   = targetPref </> dir <.> "zip"
     (zipProg, _) <- requireProgram verbosity zipProgram emptyProgramDb
@@ -94,6 +123,6 @@ createZipArchive verbosity pkg _mlbi tmpDir targetPref = do
     unless (exitCode == ExitSuccess) $
       die $ "Generating the zip file failed "
          ++ "(zip returned exit code " ++ show exitCode ++ ")"
-    return zipfile
+    notice verbosity $ "Source zip archive created: " ++ zipfileAbs
   where
     zipProgram = simpleProgram "zip"