Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/223230b4ddd5e6bce47f130db6c2c68d398261d0 >--------------------------------------------------------------- commit 223230b4ddd5e6bce47f130db6c2c68d398261d0 Author: bjorn <[email protected]> Date: Tue Oct 16 21:54:39 2007 +0000 Moved the local package index reading to a new module, Hackage.Index. >--------------------------------------------------------------- cabal-install/Hackage/Config.hs | 38 +----------------------- cabal-install/Hackage/Dependency.hs | 3 +- cabal-install/Hackage/Index.hs | 55 +++++++++++++++++++++++++++++++++++ cabal-install/Hackage/List.hs | 2 +- cabal-install/cabal-install.cabal | 1 + 5 files changed, 61 insertions(+), 38 deletions(-) diff --git a/cabal-install/Hackage/Config.hs b/cabal-install/Hackage/Config.hs index 8cfb126..88df38d 100644 --- a/cabal-install/Hackage/Config.hs +++ b/cabal-install/Hackage/Config.hs @@ -15,7 +15,6 @@ module Hackage.Config , packageFile , packageDir , listInstalledPackages - , getKnownPackages , message , pkgURL , defaultConfigFile @@ -25,25 +24,19 @@ module Hackage.Config ) where import Prelude hiding (catch) -import Control.Exception (catch, Exception(IOException)) import Control.Monad (when) -import qualified Data.ByteString.Lazy.Char8 as BS -import Data.ByteString.Lazy.Char8 (ByteString) import Data.Char (isAlphaNum, toLower) import Data.List (intersperse) import Data.Maybe (fromMaybe) import System.Directory (createDirectoryIfMissing, getAppUserDataDirectory) -import System.FilePath ((</>), takeDirectory, takeExtension, (<.>)) -import System.IO.Error (isDoesNotExistError) +import System.FilePath ((</>), takeDirectory, (<.>)) import System.IO (hPutStrLn, stderr) import Text.PrettyPrint.HughesPJ (text) import Distribution.Compat.ReadP (ReadP, char, munch1, readS_to_P) import Distribution.Compiler (CompilerFlavor(..), defaultCompilerFlavor) import Distribution.Package (PackageIdentifier(..), showPackageId) -import Distribution.PackageDescription ({- GenericPackageDescription(..), -} - {-PackageDescription(..), -} - parsePackageDescription, ParseResult(..)) +import Distribution.PackageDescription (ParseResult(..)) import Distribution.ParseUtils (FieldDescr(..), simpleField, listField, liftField, field) import Distribution.Simple.Compiler (Compiler, PackageDB(..)) import Distribution.Simple.Configure (getInstalledPackages) @@ -53,7 +46,6 @@ import Distribution.Simple.Program (ProgramConfiguration, defaultProgramConfigur import Distribution.Version (showVersion) import Distribution.Verbosity (Verbosity, normal) -import Hackage.Tar (readTarArchive, tarFileName) import Hackage.Types (ConfigFlags (..), PkgInfo (..), Repo(..), pkgInfoId) import Hackage.Utils @@ -86,32 +78,6 @@ listInstalledPackages cfg comp conf = conf return ipkgs -getKnownPackages :: ConfigFlags -> IO [PkgInfo] -getKnownPackages cfg - = fmap concat $ mapM (readRepoIndex cfg) $ configRepos cfg - -readRepoIndex :: ConfigFlags -> Repo -> IO [PkgInfo] -readRepoIndex cfg repo = - do let indexFile = repoCacheDir cfg repo </> "00-index.tar" - fmap (parseRepoIndex repo) (BS.readFile indexFile) - `catch` (\e -> do case e of - IOException ioe | isDoesNotExistError ioe -> - hPutStrLn stderr "The package list does not exist. Run 'cabal update' to download it." - _ -> hPutStrLn stderr ("Error: " ++ show e) - return []) - -parseRepoIndex :: Repo -> ByteString -> [PkgInfo] -parseRepoIndex repo s = - do (hdr, content) <- readTarArchive s - if takeExtension (tarFileName hdr) == ".cabal" - then case parsePackageDescription (BS.unpack content) of - ParseOk _ descr -> return $ PkgInfo { - pkgRepo = repo, - pkgDesc = descr - } - _ -> error $ "Couldn't read cabal file " ++ show (tarFileName hdr) - else fail "Not a .cabal file" - message :: ConfigFlags -> Verbosity -> String -> IO () message cfg v s = when (configVerbose cfg >= v) (putStrLn s) diff --git a/cabal-install/Hackage/Dependency.hs b/cabal-install/Hackage/Dependency.hs index 1b5d1d5..a724653 100644 --- a/cabal-install/Hackage/Dependency.hs +++ b/cabal-install/Hackage/Dependency.hs @@ -17,7 +17,8 @@ module Hackage.Dependency , packagesToInstall ) where -import Hackage.Config (listInstalledPackages, getKnownPackages) +import Hackage.Config (listInstalledPackages) +import Hackage.Index (getKnownPackages) import Hackage.Types (ResolvedPackage(..), UnresolvedDependency(..), ConfigFlags (..), PkgInfo (..), pkgInfoId) diff --git a/cabal-install/Hackage/Index.hs b/cabal-install/Hackage/Index.hs new file mode 100644 index 0000000..a432ae1 --- /dev/null +++ b/cabal-install/Hackage/Index.hs @@ -0,0 +1,55 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Hackage.Index +-- Copyright : (c) David Himmelstrup 2005, Bjorn Bringert 2007 +-- License : BSD-like +-- +-- Maintainer : [email protected] +-- Stability : provisional +-- Portability : portable +-- +-- Reading the local package index. +----------------------------------------------------------------------------- +module Hackage.Index (getKnownPackages) where + +import Hackage.Config +import Hackage.Types +import Hackage.Tar + +import Prelude hiding (catch) +import Control.Exception (catch, Exception(IOException)) +import qualified Data.ByteString.Lazy.Char8 as BS +import Data.ByteString.Lazy.Char8 (ByteString) +import System.FilePath ((</>), takeExtension) +import System.IO (hPutStrLn, stderr) +import System.IO.Error (isDoesNotExistError) + +import Distribution.PackageDescription (parsePackageDescription, ParseResult(..)) + + + +getKnownPackages :: ConfigFlags -> IO [PkgInfo] +getKnownPackages cfg + = fmap concat $ mapM (readRepoIndex cfg) $ configRepos cfg + +readRepoIndex :: ConfigFlags -> Repo -> IO [PkgInfo] +readRepoIndex cfg repo = + do let indexFile = repoCacheDir cfg repo </> "00-index.tar" + fmap (parseRepoIndex repo) (BS.readFile indexFile) + `catch` (\e -> do case e of + IOException ioe | isDoesNotExistError ioe -> + hPutStrLn stderr "The package list does not exist. Run 'cabal update' to download it." + _ -> hPutStrLn stderr ("Error: " ++ show e) + return []) + +parseRepoIndex :: Repo -> ByteString -> [PkgInfo] +parseRepoIndex repo s = + do (hdr, content) <- readTarArchive s + if takeExtension (tarFileName hdr) == ".cabal" + then case parsePackageDescription (BS.unpack content) of + ParseOk _ descr -> return $ PkgInfo { + pkgRepo = repo, + pkgDesc = descr + } + _ -> error $ "Couldn't read cabal file " ++ show (tarFileName hdr) + else fail "Not a .cabal file" \ No newline at end of file diff --git a/cabal-install/Hackage/List.hs b/cabal-install/Hackage/List.hs index 7386ec9..d7e0663 100644 --- a/cabal-install/Hackage/List.hs +++ b/cabal-install/Hackage/List.hs @@ -22,7 +22,7 @@ import Data.Ord (comparing) import Distribution.Package import Distribution.PackageDescription import Distribution.Version (showVersion) -import Hackage.Config (getKnownPackages) +import Hackage.Index (getKnownPackages) import Hackage.Types (PkgInfo(..), pkgInfoId, ConfigFlags(..), {- UnresolvedDependency(..)-} ) -- |Show information about packages diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 32b9a4d..8ac01b6 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -28,6 +28,7 @@ Executable cabal Hackage.Config Hackage.Dependency Hackage.Fetch + Hackage.Index Hackage.Info Hackage.Install Hackage.List _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
