Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/468946e23ef6240c8bc7d778f1cd4736b090b9cd >--------------------------------------------------------------- commit 468946e23ef6240c8bc7d778f1cd4736b090b9cd Author: Duncan Coutts <[email protected]> Date: Sun Feb 13 20:08:24 2011 +0000 Insert a separate fetch stage to the install process Helps to clarify things now that different kinds of packages are fetched in different ways. >--------------------------------------------------------------- cabal-install/Distribution/Client/FetchUtils.hs | 22 +++++ cabal-install/Distribution/Client/Install.hs | 98 +++++++++++------------ 2 files changed, 69 insertions(+), 51 deletions(-) diff --git a/cabal-install/Distribution/Client/FetchUtils.hs b/cabal-install/Distribution/Client/FetchUtils.hs index ed807c0..3f5be0a 100644 --- a/cabal-install/Distribution/Client/FetchUtils.hs +++ b/cabal-install/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 diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index 0136380..b3a8ee5 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/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 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
