Generalise InstalledPackageIndex over all Package instances

New Package class of things that can be identified by a PackageIdentifier
so that covers at least PackageIdentifier, PackageDescription and
InstalledPackageInfo. Most PackageIndex operations work for any package type.

Cabal.cabal

@@ -64,10 +64,10 @@ Library
         Distribution.Simple.Hugs,
         Distribution.Simple.Install,
         Distribution.Simple.InstallDirs,
-        Distribution.Simple.InstalledPackageIndex,
         Distribution.Simple.JHC,
         Distribution.Simple.LocalBuildInfo,
         Distribution.Simple.NHC,
+        Distribution.Simple.PackageIndex,
         Distribution.Simple.PreProcess,
         Distribution.Simple.PreProcess.Unlit,
         Distribution.Simple.Program,

Distribution/Simple/Configure.hs

@@ -59,10 +59,12 @@ import Distribution.Simple.Compiler
     , unsupportedExtensions, PackageDB(..) )
 import Distribution.Package
     ( PackageIdentifier(..), showPackageId )
+import Distribution.InstalledPackageInfo
+    ( InstalledPackageInfo )
 import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
     ( InstalledPackageInfo_(package) )
-import qualified Distribution.Simple.InstalledPackageIndex as InstalledPackageIndex
-import Distribution.Simple.InstalledPackageIndex (InstalledPackageIndex)
+import qualified Distribution.Simple.PackageIndex as PackageIndex
+import Distribution.Simple.PackageIndex (PackageIndex)
 import Distribution.PackageDescription as PD
     ( PackageDescription(..), GenericPackageDescription(..)
     , Library(..), hasLibs, Executable(..), BuildInfo(..)
@@ -229,7 +231,7 @@ configure (pkg_descr0, pbi) cfg
                 case finalizePackageDescription 
                        (configConfigurationsFlags cfg)
                        (fmap (map InstalledPackageInfo.package
-                            . InstalledPackageIndex.allPackages)
+                            . PackageIndex.allPackages)
                              maybePackageIndex)
                        System.Info.os
                        System.Info.arch
@@ -255,7 +257,7 @@ configure (pkg_descr0, pbi) cfg
           _   -> return $ map setDepByVersion (buildDepends pkg_descr)
 
         packageDependsIndex <-
-          case InstalledPackageIndex.dependencyClosure packageIndex dep_pkgs of
+          case PackageIndex.dependencyClosure packageIndex dep_pkgs of
             Left packageDependsIndex -> return packageDependsIndex
             Right broken ->
               die $ "The following installed packages are broken because other"
@@ -267,7 +269,7 @@ configure (pkg_descr0, pbi) cfg
                            ++ intercalate ", " (map showPackageId deps)
                             | (pkg, deps) <- broken ]
 
-        case InstalledPackageIndex.dependencyInconsistencies
+        case PackageIndex.dependencyInconsistencies
                packageDependsIndex (package pkg_descr) dep_pkgs of
           [] -> return ()
           inconsistencies ->
@@ -390,7 +392,7 @@ hackageUrl :: String
 hackageUrl = "http://hackage.haskell.org/cgi-bin/hackage-scripts/package/"
 
 -- | Test for a package dependency and record the version we have installed.
-configDependency :: Verbosity -> InstalledPackageIndex -> Dependency -> IO PackageIdentifier
+configDependency :: Verbosity -> PackageIndex InstalledPackageInfo -> Dependency -> IO PackageIdentifier
 configDependency verbosity index dep@(Dependency pkgname vrange) =
   case satisfyDependency ps dep of
         Nothing -> die $ "cannot satisfy dependency "
@@ -402,10 +404,10 @@ configDependency verbosity index dep@(Dependency pkgname vrange) =
                                 ++ ": using " ++ showPackageId pkg
                        return pkg
   where ps = map InstalledPackageInfo.package
-                 (InstalledPackageIndex.allPackages index)
+                 (PackageIndex.allPackages index)
 
 getInstalledPackages :: Verbosity -> Compiler -> PackageDB -> ProgramConfiguration
-                     -> IO (Maybe InstalledPackageIndex)
+                     -> IO (Maybe (PackageIndex InstalledPackageInfo))
 getInstalledPackages verbosity comp packageDb progconf = do
   info verbosity "Reading installed packages..."
   case compilerFlavor comp of

Distribution/Simple/GHC.hs

@@ -58,8 +58,8 @@ import Distribution.PackageDescription
 import Distribution.InstalledPackageInfo
                                 ( InstalledPackageInfo
                                 , parseInstalledPackageInfo )
-import Distribution.Simple.InstalledPackageIndex (InstalledPackageIndex)
-import qualified Distribution.Simple.InstalledPackageIndex as InstalledPackageIndex
+import Distribution.Simple.PackageIndex (PackageIndex)
+import qualified Distribution.Simple.PackageIndex as PackageIndex
 import Distribution.ParseUtils  ( ParseResult(..) )
 import Distribution.Simple.LocalBuildInfo
 				( LocalBuildInfo(..) )
@@ -253,13 +253,13 @@ oldLanguageExtensions =
       fglasgowExts = "-fglasgow-exts"
 
 getInstalledPackages :: Verbosity -> PackageDB -> ProgramConfiguration
-                     -> IO InstalledPackageIndex
+                     -> IO (PackageIndex InstalledPackageInfo)
 getInstalledPackages verbosity packagedb conf = do
   let packagedbs = case packagedb of
         GlobalPackageDB -> [GlobalPackageDB]
         _               -> [GlobalPackageDB, packagedb]
   pkgss <- getInstalledPackages' verbosity packagedbs conf
-  return $ mconcat [ InstalledPackageIndex.fromList pkgs
+  return $ mconcat [ PackageIndex.fromList pkgs
                    | (_, pkgs) <- pkgss ]
 
 -- | Get the packages from specific PackageDBs, not cumulative.

Distribution/Simple/Haddock.hs

@@ -70,7 +70,7 @@ import Distribution.Simple.InstallDirs (InstallDirs(..), PathTemplate,
 import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
 import Distribution.Simple.BuildPaths ( distPref, haddockPref, haddockName,
                                         hscolourPref, autogenModulesDir )
-import qualified Distribution.Simple.InstalledPackageIndex as InstalledPackageIndex
+import qualified Distribution.Simple.PackageIndex as PackageIndex
          ( lookupPackageId )
 import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
          ( InstalledPackageInfo_(..) )
@@ -297,7 +297,7 @@ haddockPackageFlags lbi htmlTemplate = do
   where
     interfaceAndHtmlPath :: PackageIdentifier -> Maybe (FilePath, FilePath)
     interfaceAndHtmlPath pkgId = do
-      pkg <- InstalledPackageIndex.lookupPackageId (installedPkgs lbi) pkgId
+      pkg <- PackageIndex.lookupPackageId (installedPkgs lbi) pkgId
       interface <- listToMaybe (InstalledPackageInfo.haddockInterfaces pkg)
       html <- case htmlTemplate of
         Nothing -> listToMaybe (InstalledPackageInfo.haddockHTMLs pkg)

Distribution/Simple/JHC.hs

@@ -50,11 +50,11 @@ import Distribution.PackageDescription as PD
 				  Executable(..), withExe, Library(..),
 				  libModules, hcOptions )
 import Distribution.InstalledPackageInfo
-				( emptyInstalledPackageInfo )
+				( InstalledPackageInfo, emptyInstalledPackageInfo )
 import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
 				( InstalledPackageInfo_(package) )
-import Distribution.Simple.InstalledPackageIndex (InstalledPackageIndex)
-import qualified Distribution.Simple.InstalledPackageIndex as InstalledPackageIndex
+import Distribution.Simple.PackageIndex (PackageIndex)
+import qualified Distribution.Simple.PackageIndex as PackageIndex
 import Distribution.Simple.LocalBuildInfo
 				( LocalBuildInfo(..) )
 import Distribution.Simple.BuildPaths
@@ -109,11 +109,11 @@ jhcLanguageExtensions =
     ]
 
 getInstalledPackages :: Verbosity -> PackageDB -> ProgramConfiguration
-                    -> IO InstalledPackageIndex
+                    -> IO (PackageIndex InstalledPackageInfo)
 getInstalledPackages verbosity _packagedb conf = do
    str <- rawSystemProgramStdoutConf verbosity jhcProgram conf ["--list-libraries"]
    case pCheck (readP_to_S (many (skipSpaces >> parsePackageId)) str) of
-     [ps] -> return $ InstalledPackageIndex.fromList
+     [ps] -> return $ PackageIndex.fromList
                     [ emptyInstalledPackageInfo {
                         InstalledPackageInfo.package = p
                       }

Distribution/Simple/LocalBuildInfo.hs

@@ -61,7 +61,8 @@ import Distribution.Simple.Program (ProgramConfiguration)
 import Distribution.PackageDescription (PackageDescription(..))
 import Distribution.Package (PackageIdentifier(..))
 import Distribution.Simple.Compiler (Compiler(..), PackageDB)
-import Distribution.Simple.InstalledPackageIndex (InstalledPackageIndex)
+import Distribution.Simple.PackageIndex (PackageIndex)
+import Distribution.InstalledPackageInfo (InstalledPackageInfo)
 
 -- |Data cached after configuration step.  See also
 -- 'Distribution.Setup.ConfigFlags'.
@@ -82,7 +83,7 @@ data LocalBuildInfo = LocalBuildInfo {
 		-- that must be satisfied in terms of version ranges.  This
 		-- field fixes those dependencies to the specific versions
 		-- available on this machine for this compiler.
-        installedPkgs :: InstalledPackageIndex,
+        installedPkgs :: PackageIndex InstalledPackageInfo,
                 -- ^ All the info about all installed packages.
         pkgDescrFile  :: Maybe FilePath,
                 -- ^ the filename containing the .cabal file, if available

Distribution/Simple/InstalledPackageIndex.hs → Distribution/Simple/PackageIndex.hs

 -----------------------------------------------------------------------------
 -- |
--- Module      :  Distribution.Simple.InstalledPackageIndex
+-- Module      :  Distribution.Simple.PackageIndex
 -- Copyright   :  (c) David Himmelstrup 2005,
 --                    Bjorn Bringert 2007,
 --                    Duncan Coutts 2008
@@ -12,9 +12,12 @@
 --
 -- The index of 'InstalledPackageInfo'.
 -----------------------------------------------------------------------------
-module Distribution.Simple.InstalledPackageIndex (
-  -- * Local installed index data type
-  InstalledPackageIndex,
+module Distribution.Simple.PackageIndex (
+  -- * Package classes
+  Package(..),
+
+  -- * Package index data type
+  PackageIndex,
 
   -- * Creating the index
   fromList,
@@ -53,16 +56,37 @@ import Data.Maybe (isNothing)
 
 import Distribution.Package (PackageIdentifier(..))
 import Distribution.InstalledPackageInfo
-         ( InstalledPackageInfo, InstalledPackageInfo_(..)
-         , emptyInstalledPackageInfo )
+         ( InstalledPackageInfo, InstalledPackageInfo_, emptyInstalledPackageInfo )
+import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
+         ( InstalledPackageInfo_(..) )
+import Distribution.PackageDescription
+         ( PackageDescription )
+import qualified Distribution.PackageDescription as PackageDescription
+         ( PackageDescription(..) )
 import Distribution.Version (Version, Dependency(Dependency), withinRange)
 import Distribution.Simple.Utils (lowercase, equating, comparing, isInfixOf)
 
+-- | Class of things that can be identified by a 'PackageIdentifier'
+--
+-- Types in this class are all notions of a package. This allows us to have
+-- different types for the different phases that packages go though, from
+-- simple name\/id, package description, configured or installed packages.
+--
+class Package pkg where
+  packageId :: pkg -> PackageIdentifier
+
+instance Package PackageIdentifier where
+  packageId = id
+instance Package (InstalledPackageInfo_ str) where
+  packageId = InstalledPackageInfo.package
+instance Package PackageDescription where
+  packageId = PackageDescription.package
+
 -- | The collection of information about packages from one or more 'PackageDB's.
 --
 -- It can be searched effeciently by package name and version.
 --
-data InstalledPackageIndex = InstalledPackageIndex
+data Package pkg => PackageIndex pkg = PackageIndex
   -- This index maps lower case package names to all the
   -- 'InstalledPackageInfo' records matching that package name
   -- case-insensitively. It includes all versions.
@@ -71,56 +95,56 @@ data InstalledPackageIndex = InstalledPackageIndex
   -- all versions satisfying a dependency, all by varying how we filter. So
   -- most queries will do a map lookup followed by a linear scan of the bucket.
   --
-  (Map String [InstalledPackageInfo])
+  (Map String [pkg])
 
   deriving (Show, Read)
 
-instance Monoid InstalledPackageIndex where
-  mempty  = InstalledPackageIndex (Map.empty)
+instance Package pkg => Monoid (PackageIndex pkg) where
+  mempty  = PackageIndex (Map.empty)
   mappend = merge
   --save one mappend with empty in the common case:
   mconcat [] = mempty
   mconcat xs = foldr1 mappend xs
 
-invariant :: InstalledPackageIndex -> Bool
-invariant (InstalledPackageIndex m) = all (uncurry goodBucket) (Map.toList m)
+invariant :: Package pkg => PackageIndex pkg -> Bool
+invariant (PackageIndex m) = all (uncurry goodBucket) (Map.toList m)
   where goodBucket name pkgs =
              lowercase name == name
           && not (null pkgs)
-          && all ((lowercase name==) . lowercase . pkgName . package) pkgs
+          && all ((lowercase name==) . lowercase . pkgName . packageId) pkgs
 --          && all (\pkg -> pkgInfoId pkg
---                       == (package . packageDescription . pkgDesc) pkg) pkgs
-          && distinct (map package pkgs)
+--                       == (packageId . packageDescription . pkgDesc) pkg) pkgs
+          && distinct (map packageId pkgs)
 
         distinct = all ((==1). length) . group . sort
 
 internalError :: String -> a
-internalError name = error ("InstalledPackageIndex." ++ name ++ ": internal error")
+internalError name = error ("PackageIndex." ++ name ++ ": internal error")
 
 -- | When building or merging we have to eliminate duplicates of the exact
 -- same package name and version (case-sensitively) to preserve the invariant.
 --
-stripDups :: [InstalledPackageInfo] -> [InstalledPackageInfo]
-stripDups = nubBy (equating package)
+stripDups :: Package pkg => [pkg] -> [pkg]
+stripDups = nubBy (equating packageId)
 
 -- | Lookup a name in the index to get all packages that match that name
 -- case-insensitively.
 --
-lookup :: InstalledPackageIndex -> String -> [InstalledPackageInfo]
-lookup index@(InstalledPackageIndex m) name =
+lookup :: Package pkg => PackageIndex pkg -> String -> [pkg]
+lookup index@(PackageIndex m) name =
   assert (invariant index) $
   case Map.lookup (lowercase name) m of
     Nothing   -> []
     Just pkgs -> pkgs
 
--- | Build an index out of a bunch of 'InstalledPackageInfo's.
+-- | Build an index out of a bunch of 'Package's.
 --
 -- If there are duplicates, earlier ones mask later one.
 --
-fromList :: [InstalledPackageInfo] -> InstalledPackageIndex
+fromList :: Package pkg => [pkg] -> PackageIndex pkg
 fromList pkgs =
-  let index = (InstalledPackageIndex . Map.map stripDups . Map.fromListWith (++))
-                [ let key = (lowercase . pkgName . package) pkg
+  let index = (PackageIndex . Map.map stripDups . Map.fromListWith (++))
+                [ let key = (lowercase . pkgName . packageId) pkg
                    in (key, [pkg])
                 | pkg <- pkgs ]
    in assert (invariant index) index
@@ -130,28 +154,28 @@ fromList pkgs =
 -- Packages from the first mask packages of the same exact name
 -- (case-sensitively) from the second.
 --
-merge :: InstalledPackageIndex -> InstalledPackageIndex -> InstalledPackageIndex
-merge i1@(InstalledPackageIndex m1) i2@(InstalledPackageIndex m2) =
+merge :: Package pkg => PackageIndex pkg -> PackageIndex pkg -> PackageIndex pkg
+merge i1@(PackageIndex m1) i2@(PackageIndex m2) =
   assert (invariant i1 && invariant i2) $
-  let index = InstalledPackageIndex (Map.unionWith mergeBuckets m1 m2)
+  let index = PackageIndex (Map.unionWith mergeBuckets m1 m2)
    in assert (invariant index) index
 
   where mergeBuckets pkgs1 pkgs2 = stripDups (pkgs1 ++ pkgs2)
 
 -- | Get all the packages from the index.
 --
-allPackages :: InstalledPackageIndex -> [InstalledPackageInfo]
-allPackages (InstalledPackageIndex m) = concat (Map.elems m)
+allPackages :: Package pkg => PackageIndex pkg -> [pkg]
+allPackages (PackageIndex m) = concat (Map.elems m)
 
 -- | Get all the packages from the index.
 --
 -- They are grouped by package name, case-sensitively.
 --
-allPackagesByName :: InstalledPackageIndex -> [[InstalledPackageInfo]]
-allPackagesByName (InstalledPackageIndex m) = concatMap groupByName (Map.elems m)
-  where groupByName :: [InstalledPackageInfo] -> [[InstalledPackageInfo]]
-        groupByName = groupBy (equating (pkgName . package))
-                    . sortBy (comparing (pkgName . package))
+allPackagesByName :: Package pkg => PackageIndex pkg -> [[pkg]]
+allPackagesByName (PackageIndex m) = concatMap groupByName (Map.elems m)
+  where groupByName :: Package pkg => [pkg] -> [[pkg]]
+        groupByName = groupBy (equating (pkgName . packageId))
+                    . sortBy (comparing (pkgName . packageId))
 
 -- | Does a case-insensitive search by package name.
 --
@@ -165,14 +189,14 @@ allPackagesByName (InstalledPackageIndex m) = concatMap groupByName (Map.elems m
 -- packages. The list of ambiguous results is split by exact package name. So
 -- it is a non-empty list of non-empty lists.
 --
-searchByName :: InstalledPackageIndex -> String -> SearchResult [InstalledPackageInfo]
+searchByName :: Package pkg => PackageIndex pkg -> String -> SearchResult [pkg]
 searchByName index name =
-  case groupBy (equating  (pkgName . package))
-     . sortBy  (comparing (pkgName . package))
+  case groupBy (equating  (pkgName . packageId))
+     . sortBy  (comparing (pkgName . packageId))
      $ lookup index name of
     []     -> None
     [pkgs] -> Unambiguous pkgs
-    pkgss  -> case find ((name==) . pkgName . package . head) pkgss of
+    pkgss  -> case find ((name==) . pkgName . packageId . head) pkgss of
                 Just pkgs -> Unambiguous pkgs
                 Nothing   -> Ambiguous   pkgss
 
@@ -182,8 +206,8 @@ data SearchResult a = None | Unambiguous a | Ambiguous [a]
 --
 -- That is, all packages that contain the given string in their name.
 --
-searchByNameSubstring :: InstalledPackageIndex -> String -> [InstalledPackageInfo]
-searchByNameSubstring (InstalledPackageIndex m) searchterm =
+searchByNameSubstring :: Package pkg => PackageIndex pkg -> String -> [pkg]
+searchByNameSubstring (PackageIndex m) searchterm =
   [ pkg
   | (name, pkgs) <- Map.toList m
   , searchterm' `isInfixOf` name
@@ -195,10 +219,10 @@ searchByNameSubstring (InstalledPackageIndex m) searchterm =
 -- Since multiple package DBs mask each other case-sensitively by package name,
 -- then we get back at most one package.
 --
-lookupPackageId :: InstalledPackageIndex -> PackageIdentifier -> Maybe InstalledPackageInfo
+lookupPackageId :: Package pkg => PackageIndex pkg -> PackageIdentifier -> Maybe pkg
 lookupPackageId index pkgid =
   case [ pkg | pkg <- lookup index (pkgName pkgid)
-             , package pkg == pkgid ] of
+             , packageId pkg == pkgid ] of
     []    -> Nothing
     [pkg] -> Just pkg
     _     -> internalError "lookupPackageIdentifier"
@@ -208,9 +232,10 @@ lookupPackageId index pkgid =
 -- We get back any number of versions of the specified package name, all
 -- satisfying the version range constraint.
 --
-lookupDependency :: InstalledPackageIndex -> Dependency -> [InstalledPackageInfo]
+lookupDependency :: Package pkg => PackageIndex pkg -> Dependency -> [pkg]
 lookupDependency index (Dependency name versionRange) =
-  [ pkg | pkg@InstalledPackageInfo { package = pkgid } <- lookup index name
+  [ pkg | pkg <- lookup index name
+        , let pkgid = packageId pkg
         , pkgName pkgid == name
         , pkgVersion pkgid `withinRange` versionRange ]
 
@@ -218,12 +243,12 @@ lookupDependency index (Dependency name versionRange) =
 --
 -- Returns such packages along with the depends that they're missing.
 --
-brokenPackages :: InstalledPackageIndex
+brokenPackages :: PackageIndex InstalledPackageInfo
                -> [(InstalledPackageInfo, [PackageIdentifier])]
 brokenPackages index =
   [ (pkg, missing)
   | pkg  <- allPackages index
-  , let missing = [ pkg' | pkg' <- depends pkg
+  , let missing = [ pkg' | pkg' <- InstalledPackageInfo.depends pkg
                          , isNothing (lookupPackageId index pkg') ]
   , not (null missing) ]
 
@@ -235,9 +260,9 @@ brokenPackages index =
 -- * Note that if any of the result is @Right []@ it is because at least one of
 -- the original given 'PackageIdentifier's do not occur in the index.
 --
-dependencyClosure :: InstalledPackageIndex
+dependencyClosure :: PackageIndex InstalledPackageInfo
                   -> [PackageIdentifier]
-                  -> Either InstalledPackageIndex
+                  -> Either (PackageIndex InstalledPackageInfo)
                             [(InstalledPackageInfo, [PackageIdentifier])]
 dependencyClosure index pkgids0 = case closure [] [] pkgids0 of
   (completed, []) -> Left  $ fromList completed
@@ -252,10 +277,11 @@ dependencyClosure index pkgids0 = case closure [] [] pkgids0 of
     closure completed failed (pkgid:pkgids) = case lookupPackageId index pkgid of
       Nothing  -> closure completed (pkgid:failed) pkgids
                -- TODO: use more effecient test here:
-      Just pkg | package pkg `elem` map package completed
+      Just pkg | packageId pkg `elem` map packageId completed
                -> closure      completed   failed  pkgids
                | otherwise
-               -> closure (pkg:completed)  failed  (depends pkg ++ pkgids)
+               -> closure (pkg:completed)  failed  pkgids'
+               where pkgids' = InstalledPackageInfo.depends pkg ++ pkgids
 
 -- | Given a package index where we assume we want to use all the packages
 -- (use 'dependencyClosure' if you need to get such a index subset) find out
@@ -267,7 +293,7 @@ dependencyClosure index pkgids0 = case closure [] [] pkgids0 of
 -- depend on it and the versions they require. These are guaranteed to be
 -- distinct.
 --
-dependencyInconsistencies :: InstalledPackageIndex
+dependencyInconsistencies :: PackageIndex InstalledPackageInfo
                           -> PackageIdentifier -> [PackageIdentifier]
                           -> [(String, [(PackageIdentifier, Version)])]
 dependencyInconsistencies index topPkg topDeps =
@@ -277,13 +303,13 @@ dependencyInconsistencies index topPkg topDeps =
   , not (null inconsistencies) ]
 
   where pseudoTopPackage = emptyInstalledPackageInfo {
-          package = topPkg,
-          depends = topDeps
+          InstalledPackageInfo.package = topPkg,
+          InstalledPackageInfo.depends = topDeps
         }
         inverseIndex = Map.fromListWith (++)
-          [ (pkgName dep, [(package pkg, pkgVersion dep)])
+          [ (pkgName dep, [(InstalledPackageInfo.package pkg, pkgVersion dep)])
           | pkg <- pseudoTopPackage : allPackages index
-          , dep <- depends pkg ]
+          , dep <- InstalledPackageInfo.depends pkg ]
 
         duplicatesBy = (\groups -> if length groups == 1
                                      then []