[commit: Cabal] master: Add a fetchPackage utility (2ed6169)

[Ian Lynagh]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/2ed616908f849ac01d250b9f39f49e4c28499dbe

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

commit 2ed616908f849ac01d250b9f39f49e4c28499dbe
Author: Duncan Coutts <duncan at community.haskell.org>
Date:   Sun Feb 13 19:40:34 2011 +0000

    Add a fetchPackage utility
    Works for any package identified by PackageLocation
    rather than just for repo packages.

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

 cabal-install/Distribution/Client/FetchUtils.hs |   39 +++++++++++++++++++++-
 1 files changed, 37 insertions(+), 2 deletions(-)

diff --git a/cabal-install/Distribution/Client/FetchUtils.hs b/cabal-install/Distribution/Client/FetchUtils.hs
index 853e25a..fb3968b 100644
--- a/cabal-install/Distribution/Client/FetchUtils.hs
+++ b/cabal-install/Distribution/Client/FetchUtils.hs
@@ -14,6 +14,7 @@
 module Distribution.Client.FetchUtils (
 
     -- * fetching packages
+    fetchPackage,
     isFetched,
 
     -- ** specifically for repo packages
@@ -30,7 +31,7 @@ import Distribution.Client.HttpUtils
 import Distribution.Package
          ( PackageId, packageName, packageVersion )
 import Distribution.Simple.Utils
-         ( info, debug, setupMessage )
+         ( notice, info, debug, setupMessage )
 import Distribution.Text
          ( display )
 import Distribution.Verbosity
@@ -38,7 +39,9 @@ import Distribution.Verbosity
 
 import Data.Maybe
 import System.Directory
-         ( doesFileExist, createDirectoryIfMissing )
+         ( doesFileExist, createDirectoryIfMissing, getTemporaryDirectory )
+import System.IO
+         ( openTempFile, hClose )
 import System.FilePath
          ( (</>), (<.>) )
 import qualified System.FilePath.Posix as FilePath.Posix
@@ -60,6 +63,38 @@ isFetched loc = case loc of
     RemoteTarballPackage _uri local -> return (isJust local)
     RepoTarballPackage repo pkgid _ -> doesFileExist (packageFile repo pkgid)
 
+
+-- | Fetch a package if we don't have it already.
+--
+fetchPackage :: Verbosity
+             -> PackageLocation (Maybe FilePath)
+             -> IO (PackageLocation FilePath)
+fetchPackage verbosity loc = case loc of
+    LocalUnpackedPackage dir  ->
+      return (LocalUnpackedPackage dir)
+    LocalTarballPackage  file ->
+      return (LocalTarballPackage  file)
+    RemoteTarballPackage uri (Just file) ->
+      return (RemoteTarballPackage uri file)
+    RepoTarballPackage repo pkgid (Just file) ->
+      return (RepoTarballPackage repo pkgid file)
+
+    RemoteTarballPackage uri Nothing -> do
+      path <- downloadTarballPackage uri
+      return (RemoteTarballPackage uri path)
+    RepoTarballPackage repo pkgid Nothing -> do
+      local <- fetchRepoTarball verbosity repo pkgid
+      return (RepoTarballPackage repo pkgid local)
+  where
+    downloadTarballPackage uri = do
+      notice verbosity ("Downloading " ++ show uri)
+      tmpdir <- getTemporaryDirectory
+      (path, hnd) <- openTempFile tmpdir "cabal-.tar.gz"
+      hClose hnd
+      downloadURI verbosity uri path
+      return path
+
+
 -- | Fetch a repo package if we don't have it already.
 --
 fetchRepoTarball :: Verbosity -> Repo -> PackageId -> IO FilePath