[commit: packages/Cabal] ghc-head: Avoid extracting a cached repository. (0229ace)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/Cabal

On branch  : ghc-head
Link       : http://git.haskell.org/?p=packages/Cabal.git;a=commit;h=0229ace2122d40dc18695d88a3f8e10fb2e3c2b0

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

commit 0229ace2122d40dc18695d88a3f8e10fb2e3c2b0
Author: Thomas Dziedzic <gostrc at gmail.com>
Date:   Wed May 22 14:08:59 2013 +0000

    Avoid extracting a cached repository.


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

0229ace2122d40dc18695d88a3f8e10fb2e3c2b0
 cabal-install/Distribution/Client/FetchUtils.hs |   13 ++++++++-----
 cabal-install/Distribution/Client/HttpUtils.hs  |   14 ++++++++++----
 cabal-install/Distribution/Client/Update.hs     |    9 +++++----
 3 files changed, 23 insertions(+), 13 deletions(-)

diff --git a/cabal-install/Distribution/Client/FetchUtils.hs b/cabal-install/Distribution/Client/FetchUtils.hs
index 3f5be0a..03a9139 100644
--- a/cabal-install/Distribution/Client/FetchUtils.hs
+++ b/cabal-install/Distribution/Client/FetchUtils.hs
@@ -113,7 +113,7 @@ fetchPackage verbosity loc = case loc of
       tmpdir <- getTemporaryDirectory
       (path, hnd) <- openTempFile tmpdir "cabal-.tar.gz"
       hClose hnd
-      downloadURI verbosity uri path
+      _ <- downloadURI verbosity uri path
       return path
 
 
@@ -136,12 +136,15 @@ fetchRepoTarball verbosity repo pkgid = do
             dir  = packageDir       repo pkgid
             path = packageFile      repo pkgid
         createDirectoryIfMissing True dir
-        downloadURI verbosity uri path
+        _ <- downloadURI verbosity uri path
         return path
 
 -- | Downloads an index file to [config-dir/packages/serv-id].
 --
-downloadIndex :: Verbosity -> RemoteRepo -> FilePath -> IO FilePath
+downloadIndex :: Verbosity
+              -> RemoteRepo
+              -> FilePath
+              -> IO (FilePath, Bool) -- ^ Path and if the file is cached.
 downloadIndex verbosity repo cacheDir = do
   let uri = (remoteRepoURI repo) {
               uriPath = uriPath (remoteRepoURI repo)
@@ -149,8 +152,8 @@ downloadIndex verbosity repo cacheDir = do
             }
       path = cacheDir </> "00-index" <.> "tar.gz"
   createDirectoryIfMissing True cacheDir
-  downloadURI verbosity uri path
-  return path
+  isCached <- downloadURI verbosity uri path
+  return (path, isCached)
 
 
 -- ------------------------------------------------------------
diff --git a/cabal-install/Distribution/Client/HttpUtils.hs b/cabal-install/Distribution/Client/HttpUtils.hs
index 142429e..6446cd2 100644
--- a/cabal-install/Distribution/Client/HttpUtils.hs
+++ b/cabal-install/Distribution/Client/HttpUtils.hs
@@ -92,9 +92,12 @@ cabalBrowse verbosity auth act = do
 downloadURI :: Verbosity
             -> URI      -- ^ What to download
             -> FilePath -- ^ Where to put it
-            -> IO ()
-downloadURI verbosity uri path | uriScheme uri == "file:" =
+            -> IO Bool  -- ^ If we have a cached version.
+downloadURI verbosity uri path | uriScheme uri == "file:" = do
   copyFileVerbose verbosity (uriPath uri) path
+  return False
+  -- Can we store the hash of the file so we can safely return True when the
+  -- hash matches to avoid unnecessary computation?
 downloadURI verbosity uri path = do
   let etagPath = path <.> "etag"
   etagPathExists <- doesFileExist etagPath
@@ -129,8 +132,11 @@ downloadURI verbosity uri path = do
       (2,0,0) -> do
         info verbosity ("Downloaded to " ++ path)
         writeFileAtomic path $ rspBody rsp
-      (3,0,4) -> notice verbosity "Skipping download: Local and remote files match."
-      (_,_,_) -> return ()
+        return False
+      (3,0,4) -> do
+        notice verbosity "Skipping download: Local and remote files match."
+        return True
+      (_,_,_) -> return False
       --FIXME: check the content-length header matches the body length.
       --TODO: stream the download into the file rather than buffering the whole
       --      thing in memory.
diff --git a/cabal-install/Distribution/Client/Update.hs b/cabal-install/Distribution/Client/Update.hs
index de400ab..b5a15f4 100644
--- a/cabal-install/Distribution/Client/Update.hs
+++ b/cabal-install/Distribution/Client/Update.hs
@@ -55,10 +55,11 @@ updateRepo verbosity repo = case repoKind repo of
   Left remoteRepo -> do
     notice verbosity $ "Downloading the latest package list from "
                     ++ remoteRepoName remoteRepo
-    indexPath <- downloadIndex verbosity remoteRepo (repoLocalDir repo)
-    writeFileAtomic (dropExtension indexPath) . maybeDecompress
-                                            =<< BS.readFile indexPath
-    updateRepoIndexCache verbosity repo
+    (indexPath, isCached) <- downloadIndex verbosity remoteRepo (repoLocalDir repo)
+    unless isCached $ do
+      writeFileAtomic (dropExtension indexPath) . maybeDecompress
+                                              =<< BS.readFile indexPath
+      updateRepoIndexCache verbosity repo
 
 checkForSelfUpgrade :: Verbosity -> [Repo] -> IO ()
 checkForSelfUpgrade verbosity repos = do