Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/12782f1cb7382f636fc4e41f3b3344999a749ebf >--------------------------------------------------------------- commit 12782f1cb7382f636fc4e41f3b3344999a749ebf Author: Duncan Coutts <[email protected]> Date: Sun Jan 23 19:37:06 2011 +0000 Change the interface of the two package index search functions Move the ambiguity checking to the only use site Both normal and substring search now return [(PackageName, [pkg])] >--------------------------------------------------------------- cabal-install/Distribution/Client/IndexUtils.hs | 24 +++++++++++----- cabal-install/Distribution/Client/List.hs | 11 +++++-- cabal-install/Distribution/Client/PackageIndex.hs | 31 ++++++++++----------- 3 files changed, 40 insertions(+), 26 deletions(-) diff --git a/cabal-install/Distribution/Client/IndexUtils.hs b/cabal-install/Distribution/Client/IndexUtils.hs index 8aa90b4..c5faf1c 100644 --- a/cabal-install/Distribution/Client/IndexUtils.hs +++ b/cabal-install/Distribution/Client/IndexUtils.hs @@ -54,7 +54,7 @@ import Distribution.Verbosity (Verbosity) import Distribution.Simple.Utils (die, warn, info, intercalate, fromUTF8) import Data.Maybe (catMaybes, fromMaybe) -import Data.List (isPrefixOf) +import Data.List (isPrefixOf, find) import Data.Monoid (Monoid(..)) import qualified Data.Map as Map import Control.Monad (MonadPlus(mplus), when) @@ -291,9 +291,19 @@ disambiguateDependencies index deps = do disambiguatePackageName :: PackageIndex AvailablePackage -> PackageName -> Either PackageName [PackageName] -disambiguatePackageName index (PackageName name) = - case PackageIndex.searchByName index name of - PackageIndex.None -> Right [] - PackageIndex.Unambiguous pkgs -> Left (pkgName (packageId (head pkgs))) - PackageIndex.Ambiguous pkgss -> Right [ pkgName (packageId pkg) - | (pkg:_) <- pkgss ] +disambiguatePackageName index pkgname@(PackageName name) = + case checkAmbiguity pkgname (map fst $ PackageIndex.searchByName index name) of + None -> Right [] + Unambiguous name' -> Left name' + Ambiguous names' -> Right names' + +checkAmbiguity :: PackageName -> [PackageName] -> MaybeAmbigious PackageName +checkAmbiguity name names = + case names of + [] -> None + [name'] -> Unambiguous name' + _ -> case find (name==) names of + Just name' -> Unambiguous name' + Nothing -> Ambiguous names + +data MaybeAmbigious a = None | Unambiguous a | Ambiguous [a] diff --git a/cabal-install/Distribution/Client/List.hs b/cabal-install/Distribution/Client/List.hs index 0633d15..09c7cdf 100644 --- a/cabal-install/Distribution/Client/List.hs +++ b/cabal-install/Distribution/Client/List.hs @@ -76,9 +76,8 @@ list verbosity packageDBs repos comp conf listFlags pats = do AvailablePackageDb available _ <- getAvailablePackages verbosity repos let pkgs | null pats = (PackageIndex.allPackages installed ,PackageIndex.allPackages available) - | otherwise = - (concatMap (PackageIndex.searchByNameSubstring installed) pats - ,concatMap (PackageIndex.searchByNameSubstring available) pats) + | otherwise = (matchingPackages installed + ,matchingPackages available) matches = installedFilter . map (uncurry mergePackageInfo) $ uncurry mergePackages pkgs @@ -102,6 +101,12 @@ list verbosity packageDBs repos comp conf listFlags pats = do onlyInstalled = fromFlag (listInstalled listFlags) simpleOutput = fromFlag (listSimpleOutput listFlags) + matchingPackages index = + [ pkg + | pat <- pats + , (_, pkgs) <- PackageIndex.searchByNameSubstring index pat + , pkg <- pkgs ] + info :: Verbosity -> PackageDBStack -> [Repo] diff --git a/cabal-install/Distribution/Client/PackageIndex.hs b/cabal-install/Distribution/Client/PackageIndex.hs index 2f336f5..b28ab39 100644 --- a/cabal-install/Distribution/Client/PackageIndex.hs +++ b/cabal-install/Distribution/Client/PackageIndex.hs @@ -59,7 +59,7 @@ import qualified Data.Tree as Tree import qualified Data.Graph as Graph import qualified Data.Array as Array import Data.Array ((!)) -import Data.List (groupBy, sortBy, nub, find, isInfixOf) +import Data.List (groupBy, sortBy, nub, isInfixOf) import Data.Monoid (Monoid(..)) import Data.Maybe (isNothing, fromMaybe) @@ -283,16 +283,14 @@ lookupDependency index (Dependency name versionRange) = -- packages. The list of ambiguous results is split by exact package name. So -- it is a non-empty list of non-empty lists. -- -searchByName :: Package pkg => PackageIndex pkg -> String -> SearchResult [pkg] +searchByName :: Package pkg => PackageIndex pkg + -> String -> [(PackageName, [pkg])] searchByName (PackageIndex m) name = - case [ pkgs | pkgs@(PackageName name',_) <- Map.toList m - , lowercase name' == lname ] of - [] -> None - [(_,pkgs)] -> Unambiguous pkgs - pkgss -> case find ((PackageName name==) . fst) pkgss of - Just (_,pkgs) -> Unambiguous pkgs - Nothing -> Ambiguous (map snd pkgss) - where lname = lowercase name + [ pkgs + | pkgs@(PackageName name',_) <- Map.toList m + , lowercase name' == lname ] + where + lname = lowercase name data SearchResult a = None | Unambiguous a | Ambiguous [a] @@ -300,13 +298,14 @@ data SearchResult a = None | Unambiguous a | Ambiguous [a] -- -- That is, all packages that contain the given string in their name. -- -searchByNameSubstring :: Package pkg => PackageIndex pkg -> String -> [pkg] +searchByNameSubstring :: Package pkg => PackageIndex pkg + -> String -> [(PackageName, [pkg])] searchByNameSubstring (PackageIndex m) searchterm = - [ pkg - | (PackageName name, pkgs) <- Map.toList m - , lsearchterm `isInfixOf` lowercase name - , pkg <- pkgs ] - where lsearchterm = lowercase searchterm + [ pkgs + | pkgs@(PackageName name, _) <- Map.toList m + , lsearchterm `isInfixOf` lowercase name ] + where + lsearchterm = lowercase searchterm -- -- * Special queries _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
