Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/063cae00498b46ccac38fadfb6cb0a0a11951b83 >--------------------------------------------------------------- commit 063cae00498b46ccac38fadfb6cb0a0a11951b83 Author: Duncan Coutts <[email protected]> Date: Wed Mar 19 00:06:33 2008 +0000 Refactor the SrcDist code in a similar way as in the Cabal lib >--------------------------------------------------------------- cabal-install/Hackage/SrcDist.hs | 74 ++++++++++++++++++++++++++------------ 1 files changed, 51 insertions(+), 23 deletions(-) diff --git a/cabal-install/Hackage/SrcDist.hs b/cabal-install/Hackage/SrcDist.hs index 5c853bf..01bba4f 100644 --- a/cabal-install/Hackage/SrcDist.hs +++ b/cabal-install/Hackage/SrcDist.hs @@ -4,43 +4,71 @@ module Hackage.SrcDist ( sdist ) where -import Distribution.Simple.SrcDist (preparePackage,tarBallName,nameVersion) +import Distribution.Simple.SrcDist + ( printPackageProblems, prepareTree, prepareSnapshotTree ) import Hackage.Tar (createTarGzFile) + +import Distribution.Package (showPackageId, Package(..)) import Distribution.PackageDescription (PackageDescription) -import Distribution.Simple.Utils (notice, defaultPackageDesc ) +import Distribution.Simple.Utils + ( withTempDirectory , defaultPackageDesc + , die, warn, notice, setupMessage ) import Distribution.Simple.Setup (SDistFlags(..), fromFlag) -import Control.Exception (finally) -import System.Directory (removeDirectoryRecursive) import Distribution.Verbosity (Verbosity) -import System.FilePath ((</>)) import Distribution.Simple.PreProcess (knownSuffixHandlers) import Distribution.PackageDescription.Parse (readPackageDescription) import Distribution.Simple.BuildPaths ( distPref, srcPref) import Distribution.Simple.Configure(maybeGetPersistBuildConfig) import Distribution.PackageDescription.Configuration ( flattenPackageDescription ) +import System.Time (getClockTime, toCalendarTime) +import System.FilePath ((</>), (<.>)) +import System.Directory (doesDirectoryExist) +import Control.Monad (when) +import Data.Maybe (isNothing) + -- |Create a source distribution. sdist :: SDistFlags -> IO () sdist flags = do - let snapshot = fromFlag (sDistSnapshot flags) - verbosity = fromFlag (sDistVerbose flags) - cabalFile <- defaultPackageDesc verbosity - pkg_descr0 <- readPackageDescription verbosity cabalFile + pkg <- return . flattenPackageDescription + =<< readPackageDescription verbosity + =<< defaultPackageDesc verbosity mb_lbi <- maybeGetPersistBuildConfig - let pkg_descr' = (flattenPackageDescription pkg_descr0) - pkg_descr <- preparePackage pkg_descr' mb_lbi verbosity snapshot srcPref knownSuffixHandlers - createArchive pkg_descr verbosity srcPref distPref - return () + let tmpDir = srcPref + + -- do some QA + printPackageProblems verbosity pkg + + exists <- doesDirectoryExist tmpDir + when exists $ + die $ "Source distribution already in place. please move or remove: " + ++ tmpDir + + when (isNothing mb_lbi) $ + warn verbosity "Cannot run preprocessors. Run 'configure' command first." + + withTempDirectory verbosity tmpDir $ do + + setupMessage verbosity "Building source dist for" (packageId pkg) + if snapshot + then getClockTime >>= toCalendarTime + >>= prepareSnapshotTree verbosity pkg mb_lbi tmpDir knownSuffixHandlers + else prepareTree verbosity pkg mb_lbi tmpDir knownSuffixHandlers + targzFile <- createArchive verbosity pkg tmpDir distPref + notice verbosity $ "Source tarball created: " ++ targzFile + + where + verbosity = fromFlag (sDistVerbose flags) + snapshot = fromFlag (sDistSnapshot flags) -- |Create an archive from a tree of source files, and clean up the tree. -createArchive :: PackageDescription - -> Verbosity - -> FilePath - -> FilePath - -> IO FilePath -createArchive pkg_descr verbosity tmpDir targetPref = do - let tarBallFilePath = targetPref </> tarBallName pkg_descr - createTarGzFile tarBallFilePath (Just tmpDir) (nameVersion pkg_descr) - `finally` removeDirectoryRecursive tmpDir - notice verbosity $ "Source tarball created: " ++ tarBallFilePath +createArchive :: Verbosity + -> PackageDescription + -> FilePath + -> FilePath + -> IO FilePath +createArchive _verbosity pkg tmpDir targetPref = do + let tarBallName = showPackageId (packageId pkg) + tarBallFilePath = targetPref </> tarBallName <.> "tar.gz" + createTarGzFile tarBallFilePath (Just tmpDir) tarBallName return tarBallFilePath _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
