[commit: Cabal] master: Use the new withTempDirectory function (8b68cfb)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/8b68cfb158721c2705cb6671398ea2b0952e6b46

>---------------------------------------------------------------

commit 8b68cfb158721c2705cb6671398ea2b0952e6b46
Author: Duncan Coutts <duncan at haskell.org>
Date:   Mon Feb 2 01:22:55 2009 +0000

    Use the new withTempDirectory function
    In particular it means that install will unpack packages into
    different temp dirs on each invocation which means that running
    install on the same package for different compilers at the same
    time should not clash. This is quite useful for testing.

>---------------------------------------------------------------

 cabal-install/Distribution/Client/Install.hs |   30 +++++++++++++-------------
 cabal-install/Distribution/Client/SrcDist.hs |   17 ++++++--------
 2 files changed, 22 insertions(+), 25 deletions(-)

diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs
index 777593e..d0afb67 100644
--- a/cabal-install/Distribution/Client/Install.hs
+++ b/cabal-install/Distribution/Client/Install.hs
@@ -82,7 +82,7 @@ import Distribution.Simple.Setup
 import qualified Distribution.Simple.Setup as Cabal
          ( installCommand, InstallFlags(..), emptyInstallFlags )
 import Distribution.Simple.Utils
-         ( defaultPackageDesc, rawSystemExit, withTempDirectory, comparing )
+         ( defaultPackageDesc, rawSystemExit, comparing )
 import Distribution.Simple.InstallDirs
          ( fromPathTemplate, toPathTemplate
          , initialPathTemplateEnv, substPathTemplate )
@@ -104,7 +104,7 @@ import Distribution.Version
 import Distribution.Simple.Utils as Utils
          ( notice, info, warn, die, intercalate )
 import Distribution.Client.Utils
-         ( inDir, mergeBy, MergeResult(..) )
+         ( inDir, mergeBy, MergeResult(..), withTempDirectory )
 import Distribution.System
          ( Platform(Platform), buildPlatform, OS(Windows), buildOS )
 import Distribution.Text
@@ -525,19 +525,19 @@ installAvailablePackage _ _ LocalUnpackedPackage installPkg =
 installAvailablePackage verbosity pkgid (RepoTarballPackage repo) installPkg =
   onFailure DownloadFailed $ do
     pkgPath <- fetchPackage verbosity repo pkgid
-    tmp <- getTemporaryDirectory
-    let tmpDirPath = tmp </> ("TMP" ++ display pkgid)
-        path = tmpDirPath </> display pkgid
-    onFailure UnpackFailed $ withTempDirectory verbosity tmpDirPath $ do
-      info verbosity $ "Extracting " ++ pkgPath
-                    ++ " to " ++ tmpDirPath ++ "..."
-      extractTarGzFile tmpDirPath pkgPath
-      let descFilePath = tmpDirPath </> display pkgid
-                                    </> display (packageName pkgid) <.> "cabal"
-      exists <- doesFileExist descFilePath
-      when (not exists) $
-        die $ "Package .cabal file not found: " ++ show descFilePath
-      installPkg (Just path)
+    onFailure UnpackFailed $ do
+      tmp <- getTemporaryDirectory
+      withTempDirectory tmp (display pkgid) $ \tmpDirPath -> do
+        info verbosity $ "Extracting " ++ pkgPath
+                      ++ " to " ++ tmpDirPath ++ "..."
+        extractTarGzFile tmpDirPath pkgPath
+        let unpackedPath = tmpDirPath </> display pkgid
+            descFilePath = unpackedPath
+                       </> display (packageName pkgid) <.> "cabal"
+        exists <- doesFileExist descFilePath
+        when (not exists) $
+          die $ "Package .cabal file not found: " ++ show descFilePath
+        installPkg (Just unpackedPath)
 
 installUnpackedPackage :: Verbosity
                    -> SetupScriptOptions
diff --git a/cabal-install/Distribution/Client/SrcDist.hs b/cabal-install/Distribution/Client/SrcDist.hs
index fa89b0f..b785aa4 100644
--- a/cabal-install/Distribution/Client/SrcDist.hs
+++ b/cabal-install/Distribution/Client/SrcDist.hs
@@ -16,8 +16,10 @@ import Distribution.PackageDescription
 import Distribution.PackageDescription.Parse
          ( readPackageDescription )
 import Distribution.Simple.Utils
-         ( withTempDirectory , defaultPackageDesc
-         , die, warn, notice, setupMessage )
+         ( defaultPackageDesc, warn, notice, setupMessage
+         , createDirectoryIfMissingVerbose )
+import Distribution.Client.Utils
+         ( withTempDirectory )
 import Distribution.Simple.Setup (SDistFlags(..), fromFlag)
 import Distribution.Verbosity (Verbosity)
 import Distribution.Simple.PreProcess (knownSuffixHandlers)
@@ -29,7 +31,6 @@ import Distribution.Text
 
 import System.Time (getClockTime, toCalendarTime)
 import System.FilePath ((</>), (<.>))
-import System.Directory (doesDirectoryExist)
 import Control.Monad (when)
 import Data.Maybe (isNothing)
 
@@ -40,20 +41,16 @@ sdist flags = do
      =<< readPackageDescription verbosity
      =<< defaultPackageDesc verbosity
   mb_lbi <- maybeGetPersistBuildConfig distPref
-  let tmpDir = srcPref distPref
+  let tmpTargetDir = srcPref distPref
 
   -- 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
+  createDirectoryIfMissingVerbose verbosity True tmpTargetDir
+  withTempDirectory tmpTargetDir "sdist." $ \tmpDir -> do
 
     date <- toCalendarTime =<< getClockTime
     let pkg' | snapshot  = snapshotPackage date pkg