Insert a separate fetch stage to the install process

Helps to clarify things now that different kinds of packages
are fetched in different ways.

Distribution/Client/FetchUtils.hs

@@ -16,6 +16,7 @@ module Distribution.Client.FetchUtils (
     -- * fetching packages
     fetchPackage,
     isFetched,
+    checkFetched,
 
     -- ** specifically for repo packages
     fetchRepoTarball,
@@ -64,6 +65,27 @@ isFetched loc = case loc of
     RepoTarballPackage repo pkgid _ -> doesFileExist (packageFile repo pkgid)
 
 
+checkFetched :: PackageLocation (Maybe FilePath)
+             -> IO (Maybe (PackageLocation FilePath))
+checkFetched loc = case loc of
+    LocalUnpackedPackage dir  ->
+      return (Just $ LocalUnpackedPackage dir)
+    LocalTarballPackage  file ->
+      return (Just $ LocalTarballPackage  file)
+    RemoteTarballPackage uri (Just file) ->
+      return (Just $ RemoteTarballPackage uri file)
+    RepoTarballPackage repo pkgid (Just file) ->
+      return (Just $ RepoTarballPackage repo pkgid file)
+
+    RemoteTarballPackage _uri Nothing -> return Nothing
+    RepoTarballPackage repo pkgid Nothing -> do
+      let file = packageFile repo pkgid
+      exists <- doesFileExist file
+      if exists
+        then return (Just $ RepoTarballPackage repo pkgid file)
+        else return Nothing
+
+
 -- | Fetch a package if we don't have it already.
 --
 fetchPackage :: Verbosity

Distribution/Client/Install.hs

@@ -53,9 +53,6 @@ import Distribution.Client.Dependency
          , PackagePreference(..)
          , Progress(..), foldProgress, )
 import Distribution.Client.FetchUtils
-         ( fetchRepoTarball )
-import Distribution.Client.HttpUtils
-         ( downloadURI )
 import qualified Distribution.Client.Haddock as Haddock (regenerateHaddockIndex)
 -- import qualified Distribution.Client.Info as Info
 import Distribution.Client.IndexUtils as IndexUtils
@@ -658,10 +655,11 @@ performInstallations verbosity
   executeInstallPlan installPlan $ \cpkg ->
     installConfiguredPackage platform compid configFlags
                              cpkg $ \configFlags' src pkg ->
-      installAvailablePackage verbosity (packageId pkg) src $ \mpath ->
-        installUnpackedPackage verbosity (setupScriptOptions installed)
-                               miscOptions configFlags' installFlags
-                               compid pkg mpath useLogFile
+      fetchAvailablePackage verbosity src $ \src' ->
+        installLocalPackage verbosity (packageId pkg) src' $ \mpath ->
+          installUnpackedPackage verbosity (setupScriptOptions installed)
+                                 miscOptions configFlags' installFlags
+                                 compid pkg mpath useLogFile
 
   where
     platform = InstallPlan.planPlatform installPlan
@@ -759,59 +757,57 @@ installConfiguredPackage platform comp configFlags
       Left _ -> error "finalizePackageDescription ConfiguredPackage failed"
       Right (desc, _) -> desc
 
+fetchAvailablePackage
+  :: Verbosity
+  -> PackageLocation (Maybe FilePath)
+  -> (PackageLocation FilePath -> IO BuildResult)
+  -> IO BuildResult
+fetchAvailablePackage verbosity src installPkg = do
+  fetched <- checkFetched src
+  case fetched of
+    Just src' -> installPkg src'
+    Nothing   -> onFailure DownloadFailed $
+                   fetchPackage verbosity src >>= installPkg
+
 
-installAvailablePackage
-  :: Verbosity -> PackageIdentifier -> PackageLocation (Maybe FilePath)
+installLocalPackage
+  :: Verbosity -> PackageIdentifier -> PackageLocation FilePath
   -> (Maybe FilePath -> IO BuildResult)
   -> IO BuildResult
-installAvailablePackage _ _ (LocalUnpackedPackage dir) installPkg =
-  installPkg (Just dir)
+installLocalPackage verbosity pkgid location installPkg = case location of
 
-installAvailablePackage verbosity pkgid
-                        (LocalTarballPackage tarballPath) installPkg = do
-  tmp <- getTemporaryDirectory
-  withTempDirectory verbosity tmp (display pkgid) $ \tmpDirPath ->
-    installLocalTarballPackage verbosity pkgid
-                               tarballPath tmpDirPath installPkg
+    LocalUnpackedPackage dir ->
+      installPkg (Just dir)
+
+    LocalTarballPackage tarballPath ->
+      installLocalTarballPackage verbosity pkgid tarballPath installPkg
+
+    RemoteTarballPackage _ tarballPath ->
+      installLocalTarballPackage verbosity pkgid tarballPath installPkg
+
+    RepoTarballPackage _ _ tarballPath ->
+      installLocalTarballPackage verbosity pkgid tarballPath installPkg
 
-installAvailablePackage verbosity pkgid
-                        (RemoteTarballPackage tarballURL _) installPkg = do
-  tmp <- getTemporaryDirectory
-  withTempDirectory verbosity tmp (display pkgid) $ \tmpDirPath ->
-    onFailure DownloadFailed $ do
-      let tarballPath = tmpDirPath </> display pkgid <.> "tar.gz"
-      --TODO: perhaps we've already had to download this to a local cache
-      --      so we even know what package version it is. So might be able
-      --      to get it from the local cache rather than from remote.
-      downloadURI verbosity tarballURL tarballPath
-      installLocalTarballPackage verbosity pkgid
-                                 tarballPath tmpDirPath installPkg
-
-installAvailablePackage verbosity pkgid (RepoTarballPackage repo _ _) installPkg =
-  onFailure DownloadFailed $ do
-    tarballPath <- fetchRepoTarball verbosity repo pkgid
-    tmp <- getTemporaryDirectory
-    withTempDirectory verbosity tmp (display pkgid) $ \tmpDirPath ->
-      installLocalTarballPackage verbosity pkgid
-                                 tarballPath tmpDirPath installPkg
 
 installLocalTarballPackage
-  :: Verbosity -> PackageIdentifier -> FilePath -> FilePath
+  :: Verbosity -> PackageIdentifier -> FilePath
   -> (Maybe FilePath -> IO BuildResult)
   -> IO BuildResult
-installLocalTarballPackage verbosity pkgid tarballPath tmpDirPath installPkg =
-  onFailure UnpackFailed $ do
-    info verbosity $ "Extracting " ++ tarballPath
-                  ++ " to " ++ tmpDirPath ++ "..."
-    let relUnpackedPath = display pkgid
-        absUnpackedPath = tmpDirPath </> relUnpackedPath
-        descFilePath = absUnpackedPath
-                   </> display (packageName pkgid) <.> "cabal"
-    extractTarGzFile tmpDirPath relUnpackedPath tarballPath
-    exists <- doesFileExist descFilePath
-    when (not exists) $
-      die $ "Package .cabal file not found: " ++ show descFilePath
-    installPkg (Just absUnpackedPath)
+installLocalTarballPackage verbosity pkgid tarballPath installPkg = do
+  tmp <- getTemporaryDirectory
+  withTempDirectory verbosity tmp (display pkgid) $ \tmpDirPath ->
+    onFailure UnpackFailed $ do
+      info verbosity $ "Extracting " ++ tarballPath
+                    ++ " to " ++ tmpDirPath ++ "..."
+      let relUnpackedPath = display pkgid
+          absUnpackedPath = tmpDirPath </> relUnpackedPath
+          descFilePath = absUnpackedPath
+                     </> display (packageName pkgid) <.> "cabal"
+      extractTarGzFile tmpDirPath relUnpackedPath tarballPath
+      exists <- doesFileExist descFilePath
+      when (not exists) $
+        die $ "Package .cabal file not found: " ++ show descFilePath
+      installPkg (Just absUnpackedPath)
 
 
 installUnpackedPackage :: Verbosity