Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/11163c47e26fd38d2769b3fdb7629ad6fe4231d4 >--------------------------------------------------------------- commit 11163c47e26fd38d2769b3fdb7629ad6fe4231d4 Author: bjorn <[email protected]> Date: Fri Oct 5 15:54:41 2007 +0000 Use the package-url field in the GenericPackageDescription to record the tarball url for each package. >--------------------------------------------------------------- .../src/Network/Hackage/CabalInstall/Config.hs | 29 +++++++++++++++----- .../src/Network/Hackage/CabalInstall/Fetch.hs | 18 +++++++++--- .../src/Network/Hackage/CabalInstall/Update.hs | 7 ----- 3 files changed, 35 insertions(+), 19 deletions(-) diff --git a/cabal-install/src/Network/Hackage/CabalInstall/Config.hs b/cabal-install/src/Network/Hackage/CabalInstall/Config.hs index ca917c9..f078c74 100644 --- a/cabal-install/src/Network/Hackage/CabalInstall/Config.hs +++ b/cabal-install/src/Network/Hackage/CabalInstall/Config.hs @@ -27,6 +27,7 @@ import Control.Exception (catch, Exception(IOException)) import Control.Monad.Error (mplus, filterM) -- Using Control.Monad.Error to get the Error instance for IO. import qualified Data.ByteString.Lazy.Char8 as BS import Data.ByteString.Lazy.Char8 (ByteString) +import Data.List (intersperse) import Data.Maybe (mapMaybe) import System.Directory (Permissions (..), getPermissions, createDirectoryIfMissing ,getTemporaryDirectory) @@ -34,9 +35,11 @@ import System.IO.Error (isDoesNotExistError) import System.IO (hPutStrLn, stderr) import System.IO.Unsafe -import Distribution.Package (PackageIdentifier) -import Distribution.PackageDescription (parseDescription, ParseResult(..)) -import Distribution.Version (Dependency) +import Distribution.Package (PackageIdentifier(..), showPackageId) +import Distribution.PackageDescription (GenericPackageDescription(..) + , PackageDescription(..) + , parseDescription, ParseResult(..)) +import Distribution.Version (Dependency, showVersion) import Distribution.Verbosity import System.FilePath ((</>), takeExtension) import System.Directory @@ -91,7 +94,7 @@ getKnownPackages cfg readRepoIndex :: ConfigFlags -> Repo -> IO [PkgInfo] readRepoIndex cfg repo = do let indexFile = repoCacheDir cfg repo </> "00-index.tar" - fmap parseRepoIndex (BS.readFile indexFile) + fmap (parseRepoIndex repo) (BS.readFile indexFile) `catch` (\e -> do hPutStrLn stderr ("Warning: Problem opening package list '" ++ indexFile ++ "'.") @@ -101,15 +104,27 @@ readRepoIndex cfg repo = _ -> hPutStrLn stderr ("Error: " ++ (show e)) return []) -parseRepoIndex :: ByteString -> [PkgInfo] -parseRepoIndex s = +parseRepoIndex :: Repo -> ByteString -> [PkgInfo] +parseRepoIndex repo s = do (name, content) <- readTarArchive s if takeExtension name == ".cabal" then case parseDescription (BS.unpack content) of - ParseOk _ descr -> return descr + ParseOk _ descr -> return $ mkPkgInfo repo descr _ -> error $ "Couldn't read cabal file " ++ show name else fail "Not a .cabal file" +mkPkgInfo :: Repo -> GenericPackageDescription -> PkgInfo +mkPkgInfo repo desc + = desc { packageDescription = (packageDescription desc) { pkgUrl = url } } + where url = pkgURL (package (packageDescription desc)) repo + +-- | Generate the URL of the tarball for a given package. +pkgURL :: PackageIdentifier -> Repo -> String +pkgURL pkg repo = joinWith "/" [repoURL repo, pkgName pkg, showVersion (pkgVersion pkg), showPackageId pkg] + ++ ".tar.gz" + where joinWith tok = concat . intersperse tok + + getKnownServers :: ConfigFlags -> IO [Repo] getKnownServers cfg = fmap readRepos (readFile (servList cfg)) diff --git a/cabal-install/src/Network/Hackage/CabalInstall/Fetch.hs b/cabal-install/src/Network/Hackage/CabalInstall/Fetch.hs index 62529c9..3637d6a 100644 --- a/cabal-install/src/Network/Hackage/CabalInstall/Fetch.hs +++ b/cabal-install/src/Network/Hackage/CabalInstall/Fetch.hs @@ -88,12 +88,15 @@ downloadFile path url -- Downloads a package to [config-dir/packages/package-id] and returns the path to the package. downloadPackage :: ConfigFlags -> PackageIdentifier -> String -> IO String downloadPackage cfg pkg url - = do message (configOutputGen cfg) verbose $ "GET " ++ show url + = do let dir = packageDir cfg pkg + path = packageFile cfg pkg + message (configOutputGen cfg) verbose $ "GET " ++ show url + createDirectoryIfMissing True dir mbError <- downloadFile path url case mbError of Just err -> fail $ printf "Failed to download '%s': %s" (showPackageId pkg) (show err) Nothing -> return path - where path = packageFile cfg pkg + where -- Downloads an index file to [config-dir/packages/serv-id]. downloadIndex :: ConfigFlags -> Repo -> IO FilePath @@ -110,12 +113,17 @@ downloadIndex cfg repo -- |Generate the full path to the locally cached copy of -- the tarball for a given @PackageIdentifer@. packageFile :: ConfigFlags -> PackageIdentifier -> FilePath -packageFile cfg pkg = packagesDirectory cfg - </> pkgName pkg - </> showVersion (pkgVersion pkg) +packageFile cfg pkg = packageDir cfg pkg </> showPackageId pkg <.> "tar.gz" +-- |Generate the full path to the directory where the local cached copy of +-- the tarball for a given @PackageIdentifer@ is stored. +packageDir :: ConfigFlags -> PackageIdentifier -> FilePath +packageDir cfg pkg = packagesDirectory cfg + </> pkgName pkg + </> showVersion (pkgVersion pkg) + -- |Returns @True@ if the package has already been fetched. isFetched :: ConfigFlags -> PackageIdentifier -> IO Bool isFetched cfg pkg diff --git a/cabal-install/src/Network/Hackage/CabalInstall/Update.hs b/cabal-install/src/Network/Hackage/CabalInstall/Update.hs index 135c95f..702ab84 100644 --- a/cabal-install/src/Network/Hackage/CabalInstall/Update.hs +++ b/cabal-install/src/Network/Hackage/CabalInstall/Update.hs @@ -28,7 +28,6 @@ import Codec.Compression.GZip(decompress) import Control.Monad (liftM, when) import qualified Data.ByteString.Lazy.Char8 as BS import Data.ByteString.Lazy.Char8 (ByteString) -import Data.List (intersperse, isSuffixOf) import Data.Version (showVersion) import Text.Printf @@ -44,9 +43,3 @@ updateRepo cfg repo = do gettingPkgList (configOutputGen cfg) (repoURL repo) indexPath <- downloadIndex cfg repo BS.readFile indexPath >>= BS.writeFile (dropExtension indexPath) . decompress - --- | Generate the URL of the tarball for a given package. -pkgURL :: PackageIdentifier -> Repo -> String -pkgURL pkg repo = joinWith "/" [repoURL repo, pkgName pkg, showVersion (pkgVersion pkg), showPackageId pkg] - ++ ".tar.gz" - where joinWith tok = concat . intersperse tok _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
