[commit: Cabal] master: Add IndexUtils with functions to disambiguate packaage names (6f36ccc)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/6f36cccf5130a3950ed8fbd356040eedc9858aca

>---------------------------------------------------------------

commit 6f36cccf5130a3950ed8fbd356040eedc9858aca
Author: Duncan Coutts <duncan at haskell.org>
Date:   Fri Jan 18 22:55:45 2008 +0000

    Add IndexUtils with functions to disambiguate packaage names
    To allow us to implement case-insensitivity in package names given on the
    command line. We lookup in the package index for packages with the same name
    case-insensitively. If there is no exact match exact case-sensitively and
    there are more than one packages matching case-insensitively then it aborts
    with a message listing the matches. This should not often happen since within
    any single HackageDB server, we can check that packages names are unique
    case-insensitively but it's possible to get ambiguities if cabal-install has
    been configured to use multiple repos.

>---------------------------------------------------------------

 cabal-install/Hackage/IndexUtils.hs |   62 +++++++++++++++++++++++++++++++++++
 cabal-install/Hackage/RepoIndex.hs  |    1 +
 cabal-install/cabal-install.cabal   |    1 +
 3 files changed, 64 insertions(+), 0 deletions(-)

diff --git a/cabal-install/Hackage/IndexUtils.hs b/cabal-install/Hackage/IndexUtils.hs
new file mode 100644
index 0000000..28024d9
--- /dev/null
+++ b/cabal-install/Hackage/IndexUtils.hs
@@ -0,0 +1,62 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Hackage.IndexUtils
+-- Copyright   :  (c) Duncan Coutts 2008
+-- License     :  BSD-like
+--
+-- Maintainer  :  duncan at haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Extra utils related to the package indexes.
+-----------------------------------------------------------------------------
+module Hackage.IndexUtils (
+  disambiguatePackageName,
+  disambiguateDependencies
+  ) where
+
+import qualified Hackage.RepoIndex as RepoIndex
+import Hackage.RepoIndex (RepoIndex)
+import Hackage.Types (UnresolvedDependency(..), PkgInfo(..))
+import Hackage.Utils (intercalate)
+
+import Distribution.Package (PackageIdentifier(..))
+import Distribution.Version (Dependency(Dependency))
+import Distribution.Simple.Utils as Utils (die)
+
+
+-- | Disambiguate a set of packages using 'disambiguatePackage' and report any
+-- ambiguities to the user.
+--
+disambiguateDependencies :: RepoIndex
+                         -> [UnresolvedDependency]
+                         -> IO [UnresolvedDependency]
+disambiguateDependencies index deps = do
+  let names = [ (name, disambiguatePackageName index name)
+              | UnresolvedDependency (Dependency name _) _ <- deps ]
+   in case [ (name, matches) | (name, Right matches) <- names ] of
+        []        -> return
+          [ UnresolvedDependency (Dependency name vrange) flags
+          | (UnresolvedDependency (Dependency _ vrange) flags,
+             (_, Left name)) <- zip deps names ]
+        ambigious -> die $ unlines
+          [ if null matches
+              then "There is no package named " ++ name
+              else "The package name " ++ name ++ "is ambigious. "
+                ++ "It could be: " ++ intercalate ", " matches
+          | (name, matches) <- ambigious ]
+
+-- | Given an index of known packages and a package name, figure out which one it
+-- might be referring to. If there is an exact case-sensitive match then that's
+-- ok. If it matches just one package case-insensitively then that's also ok.
+-- The only problem is if it matches multiple packages case-insensitively, in
+-- that case it is ambigious.
+--
+disambiguatePackageName :: RepoIndex -> String
+                                     -> Either String [String]
+disambiguatePackageName index name =
+    case RepoIndex.lookupPackageName index name of
+      RepoIndex.None              -> Right []
+      RepoIndex.Unambiguous pkgs  -> Left (pkgName (pkgInfoId (head pkgs)))
+      RepoIndex.Ambiguous   pkgss -> Right [ pkgName (pkgInfoId pkg)
+                                           | (pkg:_) <- pkgss ]
diff --git a/cabal-install/Hackage/RepoIndex.hs b/cabal-install/Hackage/RepoIndex.hs
index e0188a9..0741fec 100644
--- a/cabal-install/Hackage/RepoIndex.hs
+++ b/cabal-install/Hackage/RepoIndex.hs
@@ -26,6 +26,7 @@ module Hackage.RepoIndex (
   -- * Queries
   allPackages,
   lookupPackageName,
+  SearchResult(..),
   lookupPackageNameSubstring,
   lookupPackageIdentifier,
   lookupDependency,
diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal
index d136e14..79babc3 100644
--- a/cabal-install/cabal-install.cabal
+++ b/cabal-install/cabal-install.cabal
@@ -38,6 +38,7 @@ Executable cabal
         Hackage.Dependency
         Hackage.Fetch
         Hackage.HttpUtils
+        Hackage.IndexUtils
         Hackage.Info
         Hackage.Install
         Hackage.List