Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/388d0fa75be06444e10b4bd4a8d30facc728de55 >--------------------------------------------------------------- commit 388d0fa75be06444e10b4bd4a8d30facc728de55 Author: Duncan Coutts <[email protected]> Date: Sun Jul 17 22:36:48 2011 +0000 Update cabal sdist to follow the changes in the Cabal lib >--------------------------------------------------------------- cabal-install/Distribution/Client/SrcDist.hs | 82 +++++++++++++++++++------- 1 files changed, 60 insertions(+), 22 deletions(-) diff --git a/cabal-install/Distribution/Client/SrcDist.hs b/cabal-install/Distribution/Client/SrcDist.hs index f17a5ce..789e84e 100644 --- a/cabal-install/Distribution/Client/SrcDist.hs +++ b/cabal-install/Distribution/Client/SrcDist.hs @@ -5,20 +5,21 @@ module Distribution.Client.SrcDist ( sdist ) where import Distribution.Simple.SrcDist - ( printPackageProblems, prepareTree - , prepareSnapshotTree, snapshotPackage ) + ( printPackageProblems, prepareTree, snapshotPackage ) import Distribution.Client.Tar (createTarGzFile) import Distribution.Package - ( Package(..) ) + ( Package(..), packageVersion ) import Distribution.PackageDescription ( PackageDescription ) import Distribution.PackageDescription.Parse ( readPackageDescription ) import Distribution.Simple.Utils ( defaultPackageDesc, warn, notice, setupMessage - , createDirectoryIfMissingVerbose, withTempDirectory ) -import Distribution.Simple.Setup (SDistFlags(..), fromFlag) + , createDirectoryIfMissingVerbose, withTempDirectory + , withUTF8FileContents, writeUTF8File ) +import Distribution.Simple.Setup + ( SDistFlags(..), fromFlag, flagToMaybe ) import Distribution.Verbosity (Verbosity) import Distribution.Simple.PreProcess (knownSuffixHandlers) import Distribution.Simple.BuildPaths ( srcPref) @@ -26,11 +27,15 @@ import Distribution.Simple.Configure(maybeGetPersistBuildConfig) import Distribution.PackageDescription.Configuration ( flattenPackageDescription ) import Distribution.Text ( display ) +import Distribution.Version + ( Version ) import System.Time (getClockTime, toCalendarTime) import System.FilePath ((</>), (<.>)) import Control.Monad (when) import Data.Maybe (isNothing) +import Data.Char (toLower) +import Data.List (isPrefixOf) -- |Create a source distribution. sdist :: SDistFlags -> IO () @@ -39,7 +44,6 @@ sdist flags = do =<< readPackageDescription verbosity =<< defaultPackageDesc verbosity mb_lbi <- maybeGetPersistBuildConfig distPref - let tmpTargetDir = srcPref distPref -- do some QA printPackageProblems verbosity pkg @@ -47,25 +51,59 @@ sdist flags = do when (isNothing mb_lbi) $ warn verbosity "Cannot run preprocessors. Run 'configure' command first." - createDirectoryIfMissingVerbose verbosity True tmpTargetDir - withTempDirectory verbosity tmpTargetDir "sdist." $ \tmpDir -> do + date <- toCalendarTime =<< getClockTime + let pkg' | snapshot = snapshotPackage date pkg + | otherwise = pkg - date <- toCalendarTime =<< getClockTime - let pkg' | snapshot = snapshotPackage date pkg - | otherwise = pkg - setupMessage verbosity "Building source dist for" (packageId pkg') + case flagToMaybe (sDistDirectory flags) of + Just targetDir -> do + generateSourceDir targetDir pkg' mb_lbi + notice verbosity $ "Source directory created: " ++ targetDir - _ <- if snapshot - then prepareSnapshotTree verbosity pkg' mb_lbi distPref tmpDir pps - else prepareTree verbosity pkg' mb_lbi distPref tmpDir pps - targzFile <- createArchive verbosity pkg' tmpDir distPref - notice verbosity $ "Source tarball created: " ++ targzFile + Nothing -> do + createDirectoryIfMissingVerbose verbosity True tmpTargetDir + withTempDirectory verbosity tmpTargetDir "sdist." $ \tmpDir -> do + let targetDir = tmpDir </> tarBallName pkg' + generateSourceDir targetDir pkg' mb_lbi + targzFile <- createArchive verbosity pkg' tmpDir targetPref + notice verbosity $ "Source tarball created: " ++ targzFile where + generateSourceDir targetDir pkg' mb_lbi = do + + setupMessage verbosity "Building source dist for" (packageId pkg') + prepareTree verbosity pkg' mb_lbi distPref targetDir pps + when snapshot $ + overwriteSnapshotPackageDesc verbosity pkg' targetDir + verbosity = fromFlag (sDistVerbosity flags) snapshot = fromFlag (sDistSnapshot flags) - distPref = fromFlag (sDistDistPref flags) pps = knownSuffixHandlers + distPref = fromFlag $ sDistDistPref flags + targetPref = distPref + tmpTargetDir = srcPref distPref + +tarBallName :: PackageDescription -> String +tarBallName = display . packageId + +overwriteSnapshotPackageDesc :: Verbosity -- ^verbosity + -> PackageDescription -- ^info from the cabal file + -> FilePath -- ^source tree + -> IO () +overwriteSnapshotPackageDesc verbosity pkg targetDir = do + -- We could just writePackageDescription targetDescFile pkg_descr, + -- but that would lose comments and formatting. + descFile <- defaultPackageDesc verbosity + withUTF8FileContents descFile $ + writeUTF8File (targetDir </> descFile) + . unlines . map (replaceVersion (packageVersion pkg)) . lines + + where + replaceVersion :: Version -> String -> String + replaceVersion version line + | "version:" `isPrefixOf` map toLower line + = "version: " ++ display version + | otherwise = line -- |Create an archive from a tree of source files, and clean up the tree. createArchive :: Verbosity @@ -74,7 +112,7 @@ createArchive :: Verbosity -> FilePath -> IO FilePath createArchive _verbosity pkg tmpDir targetPref = do - let tarBallName = display (packageId pkg) - tarBallFilePath = targetPref </> tarBallName <.> "tar.gz" - createTarGzFile tarBallFilePath tmpDir tarBallName - return tarBallFilePath + createTarGzFile tarBallFilePath tmpDir (tarBallName pkg) + return tarBallFilePath + where + tarBallFilePath = targetPref </> tarBallName pkg <.> "tar.gz" _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
