[commit: Cabal] master: Update cabal sdist to follow the changes in the Cabal lib (388d0fa)

[Ian Lynagh]

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 <duncan at community.haskell.org>
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"