[commit: Cabal] master: Make package searches ~100x faster but less featurefull (9bf22f8)

[Ian Lynagh]

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 <duncan at haskell.org>
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