Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/f072dc83599d21f98315226de9d7e5a2dd3fcddc >--------------------------------------------------------------- commit f072dc83599d21f98315226de9d7e5a2dd3fcddc Author: Duncan Coutts <[email protected]> Date: Thu Jan 17 20:04:39 2008 +0000 Move package substring searching into the Index module and use it in List Not much faster but rather cleaner. >--------------------------------------------------------------- cabal-install/Hackage/Index.hs | 16 ++++++++++- cabal-install/Hackage/List.hs | 53 +++++++++++++++++---------------------- cabal-install/Hackage/Utils.hs | 9 ++++++- 3 files changed, 45 insertions(+), 33 deletions(-) diff --git a/cabal-install/Hackage/Index.hs b/cabal-install/Hackage/Index.hs index fc6467d..e52452f 100644 --- a/cabal-install/Hackage/Index.hs +++ b/cabal-install/Hackage/Index.hs @@ -24,13 +24,14 @@ module Hackage.Index ( -- * Queries allPackages, lookupPackageName, + lookupPackageNameSubstring, lookupPackageIdentifier, lookupDependency, ) where import Hackage.Types import Hackage.Tar -import Hackage.Utils (lowercase, equating, comparing) +import Hackage.Utils (lowercase, equating, comparing, isInfixOf) import Prelude hiding (catch, lookup) import Control.Exception (catch, Exception(IOException), assert) @@ -38,7 +39,6 @@ import qualified Data.Map as Map import Data.Map (Map) import Data.List (nubBy, group, sort, groupBy, sortBy, find) import Data.Monoid (Monoid(..)) -import qualified Data.Char as Char (toLower) import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy.Char8 as BS.Char8 import Data.ByteString.Lazy (ByteString) @@ -164,6 +164,18 @@ lookupPackageName index name = data SearchResult a = None | Unambiguous a | Ambiguous [a] +-- | Does a case-insensitive substring search by package name. +-- +-- That is, all packages that contain the given string in their name. +-- +lookupPackageNameSubstring :: RepoIndex -> String -> [PkgInfo] +lookupPackageNameSubstring (RepoIndex m) searchterm = + [ pkg + | (name, pkgs) <- Map.toList m + , searchterm' `isInfixOf` name + , pkg <- pkgs ] + where searchterm' = lowercase searchterm + -- | Does a case-sensitive search by package name, and also version. -- -- Since multiple repos mask each other case-sensitively by package name, then diff --git a/cabal-install/Hackage/List.hs b/cabal-install/Hackage/List.hs index 51d9ae6..3cff960 100644 --- a/cabal-install/Hackage/List.hs +++ b/cabal-install/Hackage/List.hs @@ -10,58 +10,51 @@ -- -- High level interface to package installation. ----------------------------------------------------------------------------- -module Hackage.List - ( list -- :: ConfigFlags -> [UnresolvedDependency] -> IO () - ) where +module Hackage.List ( + list + ) where -import Data.List (nubBy, sortBy, groupBy, intersperse, isPrefixOf, tails) -import Data.Char as Char (toLower) +import Data.List (nub, sortBy, groupBy) import Data.Monoid (Monoid(mconcat)) + import Distribution.Package import Distribution.PackageDescription import Distribution.Version (showVersion) import Distribution.Verbosity (Verbosity) + import qualified Hackage.Index as RepoIndex import Hackage.Types (PkgInfo(..), Repo) +import Hackage.Utils (equating, comparing, intercalate, lowercase) -- |Show information about packages list :: Verbosity -> [Repo] -> [String] -> IO () list verbosity repos pats = do indexes <- mapM (RepoIndex.read verbosity) repos - let pkgs = RepoIndex.allPackages (mconcat indexes) - pkgs' | null pats = pkgs - | otherwise = nubBy samePackage (concatMap (findInPkgs pkgs) pats') - pats' = map lcase pats + let index = mconcat indexes + pkgs | null pats = pkgs + | otherwise = + concatMap (RepoIndex.lookupPackageNameSubstring index) pats putStrLn . unlines - . map (showPkgVersions . map (packageDescription . pkgDesc)) - . groupBy sameName + . map showPkgVersions + . groupBy (equating (pkgName . pkgInfoId)) . sortBy (comparing nameAndVersion) - $ pkgs' + $ pkgs where - findInPkgs :: [PkgInfo] -> String -> [PkgInfo] - findInPkgs pkgs pat = - filter (isInfixOf pat . lcase . pkgName . pkgInfoId) pkgs - lcase = map Char.toLower - nameAndVersion p = (lcase name, name, version) + nameAndVersion p = (lowercase 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) -showPkgVersions :: [PackageDescription] -> String + +showPkgVersions :: [PkgInfo] -> String showPkgVersions pkgs = - padTo 35 (pkgName (package pkg) - ++ " [" ++ concat (intersperse ", " versions) ++ "] ") - ++ synopsis pkg + padTo 35 $ pkgName (pkgInfoId pkg) + ++ " [" + ++ intercalate ", " (map showVersion versions) + ++ "] " + ++ synopsis (packageDescription (pkgDesc pkg)) where pkg = last pkgs - versions = map (showVersion . pkgVersion . package) pkgs + versions = nub (map (pkgVersion . pkgInfoId) pkgs) padTo n s = s ++ (replicate (n - length s) ' ') - -comparing :: (Ord a) => (b -> a) -> b -> b -> Ordering -comparing p x y = compare (p x) (p y) - -isInfixOf :: String -> String -> Bool -isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) diff --git a/cabal-install/Hackage/Utils.hs b/cabal-install/Hackage/Utils.hs index 8bd7e45..2575a0d 100644 --- a/cabal-install/Hackage/Utils.hs +++ b/cabal-install/Hackage/Utils.hs @@ -6,7 +6,8 @@ import Distribution.Version (Dependency(..)) import Control.Exception import Control.Monad (guard) import qualified Data.Char as Char (toLower) -import Data.List (intersperse) +import Data.List (intersperse, isPrefixOf, tails) + import System.IO.Error (isDoesNotExistError) readFileIfExists :: FilePath -> IO (Maybe String) @@ -28,5 +29,11 @@ equating p x y = p x == p y comparing :: Ord a => (b -> a) -> b -> b -> Ordering comparing p x y = p x `compare` p y +isInfixOf :: String -> String -> Bool +isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) + +intercalate :: [a] -> [[a]] -> [a] +intercalate sep = concat . intersperse sep + lowercase :: String -> String lowercase = map Char.toLower _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
