From 2b68685acc4d38a528186c13436c60a1264087f6 Mon Sep 17 00:00:00 2001 From: Mikhail Glushenkov Date: Wed, 1 May 2013 22:06:46 +0200 Subject: [PATCH] Create source archives by running 'setup sdist --output-directory'. Fixes #403. --- Cabal/Distribution/Simple/SrcDist.hs | 21 +----- cabal-install/Distribution/Client/SrcDist.hs | 73 ++++++++++++++------ 2 files changed, 54 insertions(+), 40 deletions(-) diff --git a/Cabal/Distribution/Simple/SrcDist.hs b/Cabal/Distribution/Simple/SrcDist.hs index 06f77d9349c..13be1fa480a 100644 --- a/Cabal/Distribution/Simple/SrcDist.hs +++ b/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,19 +119,6 @@ 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 @@ -143,6 +126,8 @@ sdistWith pkg mb_lbi flags mkTmpDir pps createArchiveFun = 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 diff --git a/cabal-install/Distribution/Client/SrcDist.hs b/cabal-install/Distribution/Client/SrcDist.hs index e8af9a42068..71bd9e08589 100644 --- a/cabal-install/Distribution/Client/SrcDist.hs +++ b/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"