diff --git a/Distribution/Client/Fetch.hs b/Distribution/Client/Fetch.hs index 6e8a91a94ba..809f3195bf1 100644 --- a/Distribution/Client/Fetch.hs +++ b/Distribution/Client/Fetch.hs @@ -2,30 +2,24 @@ -- | -- Module : Distribution.Client.Fetch -- Copyright : (c) David Himmelstrup 2005 +-- Duncan Coutts 2011 -- License : BSD-like -- --- Maintainer : lemmih@gmail.com +-- Maintainer : cabal-devel@gmail.com -- Stability : provisional -- Portability : portable -- --- +-- The cabal fetch command ----------------------------------------------------------------------------- module Distribution.Client.Fetch ( - - -- * Commands fetch, - - -- * Utilities - fetchPackage, - isFetched, - downloadIndex, ) where import Distribution.Client.Types ( UnresolvedDependency (..), AvailablePackage(..) , AvailablePackageSource(..), AvailablePackageDb(..) - , Repo(..), RemoteRepo(..), LocalRepo(..) - , InstalledPackage ) + , Repo(..), InstalledPackage ) +import Distribution.Client.FetchUtils import Distribution.Client.PackageIndex (PackageIndex) import Distribution.Client.Dependency as Dependency ( resolveDependenciesWithProgress @@ -39,14 +33,11 @@ import Distribution.Client.IndexUtils as IndexUtils ( getAvailablePackages, disambiguateDependencies , getInstalledPackages ) import qualified Distribution.Client.InstallPlan as InstallPlan -import Distribution.Client.HttpUtils - ( downloadURI, isOldHackageURI ) import Distribution.Client.Setup ( FetchFlags(..) ) import Distribution.Package - ( PackageIdentifier, packageId, packageName, packageVersion - , Dependency(..) ) + ( packageId, Dependency(..) ) import qualified Distribution.Client.PackageIndex as PackageIndex import Distribution.Simple.Compiler ( Compiler(compilerId), PackageDBStack ) @@ -55,7 +46,7 @@ import Distribution.Simple.Program import Distribution.Simple.Setup ( fromFlag ) import Distribution.Simple.Utils - ( die, notice, info, debug, setupMessage ) + ( die, notice, info ) import Distribution.System ( buildPlatform ) import Distribution.Text @@ -66,61 +57,13 @@ import Distribution.Verbosity import qualified Data.Map as Map import Control.Monad ( when, filterM ) -import System.Directory - ( doesFileExist, createDirectoryIfMissing ) -import System.FilePath - ( (), (<.>) ) -import qualified System.FilePath.Posix as FilePath.Posix - ( combine, joinPath ) -import Network.URI - ( URI(uriPath) ) - - --- Downloads a package to [config-dir/packages/package-id] and returns the path to the package. -downloadPackage :: Verbosity -> Repo -> PackageIdentifier -> IO String -downloadPackage _ repo@Repo{ repoKind = Right LocalRepo } pkgid = - return (packageFile repo pkgid) - -downloadPackage verbosity repo@Repo{ repoKind = Left remoteRepo } pkgid = do - let uri = packageURI remoteRepo pkgid - dir = packageDir repo pkgid - path = packageFile repo pkgid - debug verbosity $ "GET " ++ show uri - createDirectoryIfMissing True dir - downloadURI verbosity uri path - return path - --- Downloads an index file to [config-dir/packages/serv-id]. -downloadIndex :: Verbosity -> RemoteRepo -> FilePath -> IO FilePath -downloadIndex verbosity repo cacheDir = do - let uri = (remoteRepoURI repo) { - uriPath = uriPath (remoteRepoURI repo) - `FilePath.Posix.combine` "00-index.tar.gz" - } - path = cacheDir "00-index" <.> "tar.gz" - createDirectoryIfMissing True cacheDir - downloadURI verbosity uri path - return path --- |Returns @True@ if the package has already been fetched. -isFetched :: AvailablePackage -> IO Bool -isFetched (AvailablePackage pkgid _ source) = case source of - LocalUnpackedPackage _ -> return True - LocalTarballPackage _ -> return True - RemoteTarballPackage _ -> return False --TODO: ad-hoc download caching - RepoTarballPackage repo -> doesFileExist (packageFile repo pkgid) +-- ------------------------------------------------------------ +-- * The fetch command +-- ------------------------------------------------------------ --- |Fetch a package if we don't have it already. -fetchPackage :: Verbosity -> Repo -> PackageIdentifier -> IO String -fetchPackage verbosity repo pkgid = do - fetched <- doesFileExist (packageFile repo pkgid) - if fetched - then do info verbosity $ display pkgid ++ " has already been downloaded." - return (packageFile repo pkgid) - else do setupMessage verbosity "Downloading" pkgid - downloadPackage verbosity repo pkgid - --- |Fetch a list of packages and their dependencies. +-- | Fetch a list of packages and their dependencies. +-- fetch :: Verbosity -> PackageDBStack -> [Repo] @@ -152,7 +95,7 @@ fetch verbosity packageDBs repos comp conf flags deps = do "The following packages would be fetched:" : map (display . packageId) pkgs' else sequence_ - [ fetchPackage verbosity repo pkgid + [ fetchRepoTarball verbosity repo pkgid | (AvailablePackage pkgid _ (RepoTarballPackage repo)) <- pkgs' ] where includeDeps = fromFlag (fetchDeps flags) @@ -224,36 +167,3 @@ resolvePackages verbosity includeDependencies comp <- InstallPlan.toList plan ] logMsg message rest = info verbosity message >> rest - - --- |Generate the full path to the locally cached copy of --- the tarball for a given @PackageIdentifer@. -packageFile :: Repo -> PackageIdentifier -> FilePath -packageFile repo pkgid = packageDir repo pkgid - display pkgid - <.> "tar.gz" - --- |Generate the full path to the directory where the local cached copy of --- the tarball for a given @PackageIdentifer@ is stored. -packageDir :: Repo -> PackageIdentifier -> FilePath -packageDir repo pkgid = repoLocalDir repo - display (packageName pkgid) - display (packageVersion pkgid) - --- | Generate the URI of the tarball for a given package. -packageURI :: RemoteRepo -> PackageIdentifier -> URI -packageURI repo pkgid | isOldHackageURI (remoteRepoURI repo) = - (remoteRepoURI repo) { - uriPath = FilePath.Posix.joinPath - [uriPath (remoteRepoURI repo) - ,display (packageName pkgid) - ,display (packageVersion pkgid) - ,display pkgid <.> "tar.gz"] - } -packageURI repo pkgid = - (remoteRepoURI repo) { - uriPath = FilePath.Posix.joinPath - [uriPath (remoteRepoURI repo) - ,"package" - ,display pkgid <.> "tar.gz"] - } diff --git a/Distribution/Client/FetchUtils.hs b/Distribution/Client/FetchUtils.hs new file mode 100644 index 00000000000..0302ad20255 --- /dev/null +++ b/Distribution/Client/FetchUtils.hs @@ -0,0 +1,138 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Client.FetchUtils +-- Copyright : (c) David Himmelstrup 2005 +-- Duncan Coutts 2011 +-- License : BSD-like +-- +-- Maintainer : cabal-devel@gmail.com +-- Stability : provisional +-- Portability : portable +-- +-- Functions for fetching packages +----------------------------------------------------------------------------- +module Distribution.Client.FetchUtils ( + + -- * fetching packages + isFetched, + + -- ** specifically for repo packages + fetchRepoTarball, + + -- * fetching other things + downloadIndex, + ) where + +import Distribution.Client.Types +import Distribution.Client.HttpUtils + ( downloadURI, isOldHackageURI ) + +import Distribution.Package + ( PackageId, packageName, packageVersion ) +import Distribution.Simple.Utils + ( info, debug, setupMessage ) +import Distribution.Text + ( display ) +import Distribution.Verbosity + ( Verbosity ) + +import System.Directory + ( doesFileExist, createDirectoryIfMissing ) +import System.FilePath + ( (), (<.>) ) +import qualified System.FilePath.Posix as FilePath.Posix + ( combine, joinPath ) +import Network.URI + ( URI(uriPath) ) + +-- ------------------------------------------------------------ +-- * Actually fetch things +-- ------------------------------------------------------------ + +-- | Returns @True@ if the package has already been fetched +-- or does not need fetching. +-- +isFetched :: AvailablePackage -> IO Bool +isFetched (AvailablePackage pkgid _ source) = case source of + LocalUnpackedPackage _ -> return True + LocalTarballPackage _ -> return True + RemoteTarballPackage _ -> return False --TODO: ad-hoc download caching + RepoTarballPackage repo -> doesFileExist (packageFile repo pkgid) + +-- | Fetch a repo package if we don't have it already. +-- +fetchRepoTarball :: Verbosity -> Repo -> PackageId -> IO FilePath +fetchRepoTarball verbosity repo pkgid = do + fetched <- doesFileExist (packageFile repo pkgid) + if fetched + then do info verbosity $ display pkgid ++ " has already been downloaded." + return (packageFile repo pkgid) + else do setupMessage verbosity "Downloading" pkgid + downloadPackage verbosity repo pkgid + +-- Downloads a package to [config-dir/packages/package-id] and returns the path to the package. +downloadPackage :: Verbosity -> Repo -> PackageId -> IO String +downloadPackage _ repo@Repo{ repoKind = Right LocalRepo } pkgid = + return (packageFile repo pkgid) + +downloadPackage verbosity repo@Repo{ repoKind = Left remoteRepo } pkgid = do + let uri = packageURI remoteRepo pkgid + dir = packageDir repo pkgid + path = packageFile repo pkgid + debug verbosity $ "GET " ++ show uri + createDirectoryIfMissing True dir + downloadURI verbosity uri path + return path + +-- | Downloads an index file to [config-dir/packages/serv-id]. +-- +downloadIndex :: Verbosity -> RemoteRepo -> FilePath -> IO FilePath +downloadIndex verbosity repo cacheDir = do + let uri = (remoteRepoURI repo) { + uriPath = uriPath (remoteRepoURI repo) + `FilePath.Posix.combine` "00-index.tar.gz" + } + path = cacheDir "00-index" <.> "tar.gz" + createDirectoryIfMissing True cacheDir + downloadURI verbosity uri path + return path + + +-- ------------------------------------------------------------ +-- * Path utilities +-- ------------------------------------------------------------ + +-- | Generate the full path to the locally cached copy of +-- the tarball for a given @PackageIdentifer@. +-- +packageFile :: Repo -> PackageId -> FilePath +packageFile repo pkgid = packageDir repo pkgid + display pkgid + <.> "tar.gz" + +-- | Generate the full path to the directory where the local cached copy of +-- the tarball for a given @PackageIdentifer@ is stored. +-- +packageDir :: Repo -> PackageId -> FilePath +packageDir repo pkgid = repoLocalDir repo + display (packageName pkgid) + display (packageVersion pkgid) + +-- | Generate the URI of the tarball for a given package. +-- +packageURI :: RemoteRepo -> PackageId -> URI +packageURI repo pkgid | isOldHackageURI (remoteRepoURI repo) = + (remoteRepoURI repo) { + uriPath = FilePath.Posix.joinPath + [uriPath (remoteRepoURI repo) + ,display (packageName pkgid) + ,display (packageVersion pkgid) + ,display pkgid <.> "tar.gz"] + } +packageURI repo pkgid = + (remoteRepoURI repo) { + uriPath = FilePath.Posix.joinPath + [uriPath (remoteRepoURI repo) + ,"package" + ,display pkgid <.> "tar.gz"] + } diff --git a/Distribution/Client/Install.hs b/Distribution/Client/Install.hs index 5eb00c7e210..61a6e1fd041 100644 --- a/Distribution/Client/Install.hs +++ b/Distribution/Client/Install.hs @@ -52,8 +52,8 @@ import Distribution.Client.Dependency , PackagesPreference(..), PackagesPreferenceDefault(..) , PackagePreference(..) , Progress(..), foldProgress, ) -import Distribution.Client.Fetch - ( fetchPackage ) +import Distribution.Client.FetchUtils + ( fetchRepoTarball ) import Distribution.Client.HttpUtils ( downloadURI ) import qualified Distribution.Client.Haddock as Haddock (regenerateHaddockIndex) @@ -791,7 +791,7 @@ installAvailablePackage verbosity pkgid installAvailablePackage verbosity pkgid (RepoTarballPackage repo) installPkg = onFailure DownloadFailed $ do - tarballPath <- fetchPackage verbosity repo pkgid + tarballPath <- fetchRepoTarball verbosity repo pkgid tmp <- getTemporaryDirectory withTempDirectory verbosity tmp (display pkgid) $ \tmpDirPath -> installLocalTarballPackage verbosity pkgid diff --git a/Distribution/Client/List.hs b/Distribution/Client/List.hs index 09c7cdf5d6e..08101e68ddc 100644 --- a/Distribution/Client/List.hs +++ b/Distribution/Client/List.hs @@ -46,7 +46,7 @@ import Distribution.Client.Utils import Distribution.Client.IndexUtils as IndexUtils ( getAvailablePackages, disambiguateDependencies , getInstalledPackages ) -import Distribution.Client.Fetch +import Distribution.Client.FetchUtils ( isFetched ) import Data.List diff --git a/Distribution/Client/Unpack.hs b/Distribution/Client/Unpack.hs index ce7780bfc4e..eca6a110c11 100644 --- a/Distribution/Client/Unpack.hs +++ b/Distribution/Client/Unpack.hs @@ -37,8 +37,8 @@ import Distribution.Client.Dependency as Dependency , dependencyConstraints, dependencyTargets , PackagesPreference(..), PackagesPreferenceDefault(..) , PackagePreference(..) ) -import Distribution.Client.Fetch - ( fetchPackage ) +import Distribution.Client.FetchUtils + ( fetchRepoTarball ) import Distribution.Client.HttpUtils ( downloadURI ) import qualified Distribution.Client.Tar as Tar (extractTarGzFile) @@ -91,7 +91,7 @@ unpack flags repos deps = do unpackPackage verbosity prefix pkgid tarballPath AvailablePackage pkgid _ (RepoTarballPackage repo) -> do - tarballPath <- fetchPackage verbosity repo pkgid + tarballPath <- fetchRepoTarball verbosity repo pkgid unpackPackage verbosity prefix pkgid tarballPath AvailablePackage _ _ (LocalUnpackedPackage _) -> diff --git a/Distribution/Client/Update.hs b/Distribution/Client/Update.hs index 87f10fab222..a3a7f373368 100644 --- a/Distribution/Client/Update.hs +++ b/Distribution/Client/Update.hs @@ -16,7 +16,7 @@ module Distribution.Client.Update import Distribution.Client.Types ( Repo(..), RemoteRepo(..), LocalRepo(..), AvailablePackageDb(..) ) -import Distribution.Client.Fetch +import Distribution.Client.FetchUtils ( downloadIndex ) import qualified Distribution.Client.PackageIndex as PackageIndex import Distribution.Client.IndexUtils diff --git a/cabal-install.cabal b/cabal-install.cabal index cef627b7bcb..b755e1c87f3 100644 --- a/cabal-install.cabal +++ b/cabal-install.cabal @@ -56,6 +56,7 @@ Executable cabal Distribution.Client.Dependency.TopDown.Types Distribution.Client.Dependency.Types Distribution.Client.Fetch + Distribution.Client.FetchUtils Distribution.Client.GZipUtils Distribution.Client.Haddock Distribution.Client.HttpUtils