[commit: Cabal] master: Change the interface of the two package index search functions (12782f1)

[Ian Lynagh]

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