Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/9bf22f8fdda525a3f3d64a0897930228cfe36f06 >--------------------------------------------------------------- commit 9bf22f8fdda525a3f3d64a0897930228cfe36f06 Author: Duncan Coutts <[email protected]> Date: Wed Oct 17 00:43:09 2007 +0000 Make package searches ~100x faster but less featurefull Instead of parsing every .cabal file in the package list (which is very slow) We now just get the package name and version and do a case-insensitive substring search on the package name. The output format remains unchanged. So we no longer search inside package descriptions. >--------------------------------------------------------------- cabal-install/Hackage/Index.hs | 29 ++++++++++++++++-------- cabal-install/Hackage/Install.hs | 2 +- cabal-install/Hackage/List.hs | 45 ++++++++++++++++++++----------------- cabal-install/Hackage/Types.hs | 6 +--- 4 files changed, 46 insertions(+), 36 deletions(-) diff --git a/cabal-install/Hackage/Index.hs b/cabal-install/Hackage/Index.hs index a432ae1..2a324df 100644 --- a/cabal-install/Hackage/Index.hs +++ b/cabal-install/Hackage/Index.hs @@ -20,13 +20,13 @@ 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.FilePath ((</>), takeExtension, splitDirectories, normalise) import System.IO (hPutStrLn, stderr) import System.IO.Error (isDoesNotExistError) import Distribution.PackageDescription (parsePackageDescription, ParseResult(..)) - - +import Distribution.Package (PackageIdentifier(..)) +import Distribution.Version (readVersion) getKnownPackages :: ConfigFlags -> IO [PkgInfo] getKnownPackages cfg @@ -46,10 +46,19 @@ 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 + then case splitDirectories (normalise (tarFileName hdr)) of + [pkgname,vers,_] -> + let descr = case parsePackageDescription (BS.unpack content) of + ParseOk _ d -> d + _ -> error $ "Couldn't read cabal file " + ++ show (tarFileName hdr) + in case readVersion vers of + Just ver -> + return $ PkgInfo { + pkgInfoId = PackageIdentifier pkgname ver, + pkgRepo = repo, + pkgDesc = descr + } + _ -> [] + _ -> [] + else [] diff --git a/cabal-install/Hackage/Install.hs b/cabal-install/Hackage/Install.hs index e25b4a8..eff40e4 100644 --- a/cabal-install/Hackage/Install.hs +++ b/cabal-install/Hackage/Install.hs @@ -162,4 +162,4 @@ installUnpackedPkg cfg comp globalArgs pkgId opts mpath = do let cmdOps = mkPkgOps cfg comp pkgId cmd (globalArgs++opts) message cfg verbose $ unwords ["setupWrapper", show (cmd:cmdOps), show mpath] - setupWrapper (cmd:cmdOps) mpath \ No newline at end of file + setupWrapper (cmd:cmdOps) mpath diff --git a/cabal-install/Hackage/List.hs b/cabal-install/Hackage/List.hs index d7e0663..6782382 100644 --- a/cabal-install/Hackage/List.hs +++ b/cabal-install/Hackage/List.hs @@ -30,29 +30,32 @@ list :: ConfigFlags -> [String] -> IO () list cfg pats = do pkgs <- getKnownPackages cfg let pkgs' | null pats = pkgs - | otherwise = nubBy samePackage (concatMap (findInPkgs pkgs) pats) - mapM_ doList (groupBy sameName (sortBy (comparing nameAndVersion) pkgs')) - where + | otherwise = nubBy samePackage (concatMap (findInPkgs pkgs) pats') + pats' = map lcase pats + putStrLn + . unlines + . map (showPkgVersions . map (packageDescription . pkgDesc)) + . groupBy sameName + . sortBy (comparing nameAndVersion) + $ pkgs' + + where findInPkgs :: [PkgInfo] -> String -> [PkgInfo] - findInPkgs pkgs pat = let rx = mkRegexWithOpts pat False False in - filter (isJust . matchRegex rx . showInfo) pkgs - showInfo :: PkgInfo -> String - showInfo pkg = showPackageId (package d) ++ "\n" ++ synopsis d - where d = packageDescription (pkgDesc pkg) - nameAndVersion p = (map Char.toLower name, name, version) - where d = packageDescription (pkgDesc p) - name = pkgName (package d) - version = pkgVersion (package d) + findInPkgs pkgs pat = + filter (isInfixOf pat . lcase . pkgName . pkgInfoId) pkgs + lcase = map Char.toLower + nameAndVersion p = (lcase name, name, version) + where name = pkgName (pkgInfoId p) + version = pkgVersion (pkgInfoId p) samePackage a b = nameAndVersion a == nameAndVersion b sameName a b = pkgName (pkgInfoId a) == pkgName (pkgInfoId b) -doList :: [PkgInfo] -> IO () -doList ps = do - putStr $ padTo 35 $ pkgName (package d) ++ " [" ++ concat (intersperse ", " versions) ++ "]" - putStrLn syn - where - info = last ps - d = packageDescription (pkgDesc info) - syn = synopsis d - versions = map (showVersion . pkgVersion . package . packageDescription . pkgDesc) ps +showPkgVersions :: [PackageDescription] -> String +showPkgVersions pkgs = + padTo 35 (pkgName (package pkg) + ++ " [" ++ concat (intersperse ", " versions) ++ "] ") + ++ synopsis pkg + where + pkg = last pkgs + versions = map (showVersion . pkgVersion . package) pkgs padTo n s = s ++ (replicate (n - length s) ' ') diff --git a/cabal-install/Hackage/Types.hs b/cabal-install/Hackage/Types.hs index b96c6c0..85bd451 100644 --- a/cabal-install/Hackage/Types.hs +++ b/cabal-install/Hackage/Types.hs @@ -15,21 +15,19 @@ module Hackage.Types where import Distribution.Simple.Compiler (CompilerFlavor) import Distribution.Simple.InstallDirs (InstallDirTemplates) import Distribution.Package (PackageIdentifier) -import Distribution.PackageDescription (GenericPackageDescription, packageDescription, package) +import Distribution.PackageDescription (GenericPackageDescription) import Distribution.Version (Dependency) import Distribution.Verbosity -- | We re-use @GenericPackageDescription@ and use the @package-url@ -- field to store the tarball URL. data PkgInfo = PkgInfo { + pkgInfoId :: PackageIdentifier, pkgRepo :: Repo, pkgDesc :: GenericPackageDescription } deriving (Show) -pkgInfoId :: PkgInfo -> PackageIdentifier -pkgInfoId = package . packageDescription . pkgDesc - data Action = FetchCmd | InstallCmd _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
