Distribution/Simple/PackageIndex.hs

    {-# LANGUAGE CPP           #-}
    {-# LANGUAGE DeriveGeneric #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Distribution.Simple.PackageIndex
    -- Copyright   :  (c) David Himmelstrup 2005,
    --                    Bjorn Bringert 2007,
    --                    Duncan Coutts 2008-2009
    --
    -- Maintainer  :  cabal-devel@haskell.org
    -- Portability :  portable
    --
    -- An index of packages.
    --
    module Distribution.Simple.PackageIndex (
      -- * Package index data type
      InstalledPackageIndex,
      PackageIndex,
      FakeMap,

      -- * Creating an index
      fromList,

      -- * Updates
      merge,

      insert,

      deleteInstalledPackageId,
      deleteSourcePackageId,
      deletePackageName,
    --  deleteDependency,

      -- * Queries

      -- ** Precise lookups
      lookupInstalledPackageId,
      lookupSourcePackageId,
      lookupPackageId,
      lookupPackageName,
      lookupDependency,

      -- ** Case-insensitive searches
      searchByName,
      SearchResult(..),
      searchByNameSubstring,

      -- ** Bulk queries
      allPackages,
      allPackagesByName,
      allPackagesBySourcePackageId,

      -- ** Special queries
      brokenPackages,
      dependencyClosure,
      reverseDependencyClosure,
      topologicalOrder,
      reverseTopologicalOrder,
      dependencyInconsistencies,
      dependencyCycles,
      dependencyGraph,
      moduleNameIndex,

      -- ** Variants of special queries supporting fake map
      fakeLookupInstalledPackageId,
      brokenPackages',
      dependencyClosure',
      reverseDependencyClosure',
      dependencyInconsistencies',
      dependencyCycles',
      dependencyGraph',
      ) where

    import Control.Exception (assert)
    import Data.Array ((!))
    import qualified Data.Array as Array
    import Distribution.Compat.Binary (Binary)
    import qualified Data.Graph as Graph
    import Data.List as List
             ( null, foldl', sort
             , groupBy, sortBy, find, isInfixOf, nubBy, deleteBy, deleteFirstsBy )
    #if __GLASGOW_HASKELL__ < 710
    import Data.Monoid (Monoid(..))
    #endif
    import Data.Map (Map)
    import qualified Data.Map as Map
    import Data.Maybe (isNothing, fromMaybe)
    import qualified Data.Tree  as Tree
    import GHC.Generics (Generic)
    import Prelude hiding (lookup)

    import Distribution.Package
             ( PackageName(..), PackageId
             , Package(..), packageName, packageVersion
             , Dependency(Dependency)--, --PackageFixedDeps(..)
             , InstalledPackageId(..), PackageInstalled(..) )
    import Distribution.ModuleName
             ( ModuleName )
    import Distribution.InstalledPackageInfo
             ( InstalledPackageInfo )
    import qualified Distribution.InstalledPackageInfo as IPI
    import Distribution.Version
             ( Version, withinRange )
    import Distribution.Simple.Utils (lowercase, comparing, equating)

    -- Note [FakeMap]
    -----------------
    -- We'd like to use the PackageIndex defined in this module for
    -- cabal-install's InstallPlan.  However, at the moment, this
    -- data structure is indexed by InstalledPackageId, which we don't
    -- know until after we've compiled a package (whereas InstallPlan
    -- needs to store not-compiled packages in the index.) Eventually,
    -- an InstalledPackageId will be calculatable prior to actually
    -- building the package (making it something of a misnomer), but
    -- at the moment, the "fake installed package ID map" is a workaround
    -- to solve this problem while reusing PackageIndex.  The basic idea
    -- is that, since we don't know what an InstalledPackageId is
    -- beforehand, we just fake up one based on the package ID (it only
    -- needs to be unique for the particular install plan), and fill
    -- it out with the actual generated InstalledPackageId after the
    -- package is successfully compiled.
    --
    -- However, there is a problem: in the index there may be
    -- references using the old package ID, which are now dangling if
    -- we update the InstalledPackageId.  We could map over the entire
    -- index to update these pointers as well (a costly operation), but
    -- instead, we've chosen to parametrize a variety of important functions
    -- by a FakeMap, which records what a fake installed package ID was
    -- actually resolved to post-compilation.  If we do a lookup, we first
    -- check and see if it's a fake ID in the FakeMap.
    --
    -- It's a bit grungy, but we expect this to only be temporary anyway.
    -- (Another possible workaround would have been to *not* update
    -- the installed package ID, but I decided this would be hard to
    -- understand.)

    -- | Map from fake installed package IDs to real ones.  See Note [FakeMap]
    type FakeMap = Map InstalledPackageId InstalledPackageId

    -- | The collection of information about packages from one or more 'PackageDB's.
    -- These packages generally should have an instance of 'PackageInstalled'
    --
    -- Packages are uniquely identified in by their 'InstalledPackageId', they can
    -- also be efficiently looked up by package name or by name and version.
    --
    data PackageIndex a = PackageIndex
      -- The primary index. Each InstalledPackageInfo record is uniquely identified
      -- by its InstalledPackageId.
      --
      !(Map InstalledPackageId a)

      -- This auxiliary index maps package names (case-sensitively) to all the
      -- versions and instances of that package. This allows us to find all
      -- versions satisfying a dependency.
      --
      -- It is a three-level index. The first level is the package name,
      -- the second is the package version and the final level is instances
      -- of the same package version. These are unique by InstalledPackageId
      -- and are kept in preference order.
      --
      -- FIXME: Clarify what "preference order" means. Check that this invariant is
      -- preserved. See #1463 for discussion.
      !(Map PackageName (Map Version [a]))

      deriving (Generic, Show, Read)

    instance Binary a => Binary (PackageIndex a)

    -- | The default package index which contains 'InstalledPackageInfo'.  Normally
    -- use this.
    type InstalledPackageIndex = PackageIndex InstalledPackageInfo

    instance PackageInstalled a => Monoid (PackageIndex a) where
      mempty  = PackageIndex Map.empty Map.empty
      mappend = merge
      --save one mappend with empty in the common case:
      mconcat [] = mempty
      mconcat xs = foldr1 mappend xs

    invariant :: PackageInstalled a => PackageIndex a -> Bool
    invariant (PackageIndex pids pnames) =
         map installedPackageId (Map.elems pids)
      == sort
         [ assert pinstOk (installedPackageId pinst)
         | (pname, pvers)  <- Map.toList pnames
         , let pversOk = not (Map.null pvers)
         , (pver,  pinsts) <- assert pversOk $ Map.toList pvers
         , let pinsts'  = sortBy (comparing installedPackageId) pinsts
               pinstsOk = all (\g -> length g == 1)
                              (groupBy (equating installedPackageId) pinsts')
         , pinst           <- assert pinstsOk $ pinsts'
         , let pinstOk = packageName    pinst == pname
                      && packageVersion pinst == pver
         ]

    --
    -- * Internal helpers
    --

    mkPackageIndex :: PackageInstalled a
                   => Map InstalledPackageId a
                   -> Map PackageName (Map Version [a])
                   -> PackageIndex a
    mkPackageIndex pids pnames = assert (invariant index) index
      where index = PackageIndex pids pnames

    --
    -- * Construction
    --

    -- | Build an index out of a bunch of packages.
    --
    -- If there are duplicates by 'InstalledPackageId' then later ones mask earlier
    -- ones.
    --
    fromList :: PackageInstalled a => [a] -> PackageIndex a
    fromList pkgs = mkPackageIndex pids pnames
      where
        pids      = Map.fromList [ (installedPackageId pkg, pkg) | pkg <- pkgs ]
        pnames    =
          Map.fromList
            [ (packageName (head pkgsN), pvers)
            | pkgsN <- groupBy (equating  packageName)
                     . sortBy  (comparing packageId)
                     $ pkgs
            , let pvers =
                    Map.fromList
                    [ (packageVersion (head pkgsNV),
                       nubBy (equating installedPackageId) (reverse pkgsNV))
                    | pkgsNV <- groupBy (equating packageVersion) pkgsN
                    ]
            ]

    --
    -- * Updates
    --

    -- | Merge two indexes.
    --
    -- Packages from the second mask packages from the first if they have the exact
    -- same 'InstalledPackageId'.
    --
    -- For packages with the same source 'PackageId', packages from the second are
    -- \"preferred\" over those from the first. Being preferred means they are top
    -- result when we do a lookup by source 'PackageId'. This is the mechanism we
    -- use to prefer user packages over global packages.
    --
    merge :: PackageInstalled a => PackageIndex a -> PackageIndex a -> PackageIndex a
    merge (PackageIndex pids1 pnames1) (PackageIndex pids2 pnames2) =
      mkPackageIndex (Map.unionWith (\_ y -> y) pids1 pids2)
                     (Map.unionWith (Map.unionWith mergeBuckets) pnames1 pnames2)
      where
        -- Packages in the second list mask those in the first, however preferred
        -- packages go first in the list.
        mergeBuckets xs ys = ys ++ (xs \\ ys)
        (\\) = deleteFirstsBy (equating installedPackageId)

    -- | Inserts a single package into the index.
    --
    -- This is equivalent to (but slightly quicker than) using 'mappend' or
    -- 'merge' with a singleton index.
    --
    insert :: PackageInstalled a => a -> PackageIndex a -> PackageIndex a
    insert pkg (PackageIndex pids pnames) =
        mkPackageIndex pids' pnames'

      where
        pids'   = Map.insert (installedPackageId pkg) pkg pids
        pnames' = insertPackageName pnames
        insertPackageName =
          Map.insertWith' (\_ -> insertPackageVersion)
                         (packageName pkg)
                         (Map.singleton (packageVersion pkg) [pkg])

        insertPackageVersion =
          Map.insertWith' (\_ -> insertPackageInstance)
                         (packageVersion pkg) [pkg]

        insertPackageInstance pkgs =
          pkg : deleteBy (equating installedPackageId) pkg pkgs

    -- | Removes a single installed package from the index.
    --
    deleteInstalledPackageId :: PackageInstalled a => InstalledPackageId -> PackageIndex a -> PackageIndex a
    deleteInstalledPackageId ipkgid original@(PackageIndex pids pnames) =
      case Map.updateLookupWithKey (\_ _ -> Nothing) ipkgid pids of
        (Nothing,     _)     -> original
        (Just spkgid, pids') -> mkPackageIndex pids'
                                              (deletePkgName spkgid pnames)

      where
        deletePkgName spkgid =
          Map.update (deletePkgVersion spkgid) (packageName spkgid)

        deletePkgVersion spkgid =
            (\m -> if Map.null m then Nothing else Just m)
          . Map.update deletePkgInstance (packageVersion spkgid)

        deletePkgInstance =
            (\xs -> if List.null xs then Nothing else Just xs)
          . List.deleteBy (\_ pkg -> installedPackageId pkg == ipkgid) undefined

    -- | Removes all packages with this source 'PackageId' from the index.
    --
    deleteSourcePackageId :: PackageInstalled a => PackageId -> PackageIndex a -> PackageIndex a
    deleteSourcePackageId pkgid original@(PackageIndex pids pnames) =
      case Map.lookup (packageName pkgid) pnames of
        Nothing     -> original
        Just pvers  -> case Map.lookup (packageVersion pkgid) pvers of
          Nothing   -> original
          Just pkgs -> mkPackageIndex
                         (foldl' (flip (Map.delete . installedPackageId)) pids pkgs)
                         (deletePkgName pnames)
      where
        deletePkgName =
          Map.update deletePkgVersion (packageName pkgid)

        deletePkgVersion =
            (\m -> if Map.null m then Nothing else Just m)
          . Map.delete (packageVersion pkgid)

    -- | Removes all packages with this (case-sensitive) name from the index.
    --
    deletePackageName :: PackageInstalled a => PackageName -> PackageIndex a -> PackageIndex a
    deletePackageName name original@(PackageIndex pids pnames) =
      case Map.lookup name pnames of
        Nothing     -> original
        Just pvers  -> mkPackageIndex
                         (foldl' (flip (Map.delete . installedPackageId)) pids
                                 (concat (Map.elems pvers)))
                         (Map.delete name pnames)

    {-
    -- | Removes all packages satisfying this dependency from the index.
    --
    deleteDependency :: Dependency -> PackageIndex -> PackageIndex
    deleteDependency (Dependency name verstionRange) =
      delete' name (\pkg -> packageVersion pkg `withinRange` verstionRange)
    -}

    --
    -- * Bulk queries
    --

    -- | Get all the packages from the index.
    --
    allPackages :: PackageIndex a -> [a]
    allPackages (PackageIndex pids _) = Map.elems pids

    -- | Get all the packages from the index.
    --
    -- They are grouped by package name (case-sensitively).
    --
    allPackagesByName :: PackageIndex a -> [(PackageName, [a])]
    allPackagesByName (PackageIndex _ pnames) =
      [ (pkgname, concat (Map.elems pvers))
      | (pkgname, pvers) <- Map.toList pnames ]

    -- | Get all the packages from the index.
    --
    -- They are grouped by source package id (package name and version).
    --
    allPackagesBySourcePackageId :: PackageInstalled a => PackageIndex a -> [(PackageId, [a])]
    allPackagesBySourcePackageId (PackageIndex _ pnames) =
      [ (packageId ipkg, ipkgs)
      | pvers <- Map.elems pnames
      , ipkgs@(ipkg:_) <- Map.elems pvers ]

    --
    -- * Lookups
    --

    -- | Does a lookup by source package id (name & version).
    --
    -- Since multiple package DBs mask each other by 'InstalledPackageId',
    -- then we get back at most one package.
    --
    lookupInstalledPackageId :: PackageInstalled a => PackageIndex a -> InstalledPackageId
                             -> Maybe a
    lookupInstalledPackageId (PackageIndex pids _) pid = Map.lookup pid pids

    -- | Does a lookup by source package id (name & version).
    --
    -- There can be multiple installed packages with the same source 'PackageId'
    -- but different 'InstalledPackageId'. They are returned in order of
    -- preference, with the most preferred first.
    --
    lookupSourcePackageId :: PackageInstalled a => PackageIndex a -> PackageId -> [a]
    lookupSourcePackageId (PackageIndex _ pnames) pkgid =
      case Map.lookup (packageName pkgid) pnames of
        Nothing     -> []
        Just pvers  -> case Map.lookup (packageVersion pkgid) pvers of
          Nothing   -> []
          Just pkgs -> pkgs -- in preference order

    -- | Convenient alias of 'lookupSourcePackageId', but assuming only
    -- one package per package ID.
    lookupPackageId :: PackageInstalled a => PackageIndex a -> PackageId -> Maybe a
    lookupPackageId index pkgid = case lookupSourcePackageId index pkgid  of
        []    -> Nothing
        [pkg] -> Just pkg
        _     -> error "Distribution.Simple.PackageIndex: multiple matches found"

    -- | Does a lookup by source package name.
    --
    lookupPackageName :: PackageInstalled a => PackageIndex a -> PackageName
                      -> [(Version, [a])]
    lookupPackageName (PackageIndex _ pnames) name =
      case Map.lookup name pnames of
        Nothing     -> []
        Just pvers  -> Map.toList pvers

    -- | Does a lookup by source package name and a range of versions.
    --
    -- We get back any number of versions of the specified package name, all
    -- satisfying the version range constraint.
    --
    lookupDependency :: PackageInstalled a => PackageIndex a -> Dependency
                     -> [(Version, [a])]
    lookupDependency (PackageIndex _ pnames) (Dependency name versionRange) =
      case Map.lookup name pnames of
        Nothing    -> []
        Just pvers -> [ entry
                      | entry@(ver, _) <- Map.toList pvers
                      , ver `withinRange` versionRange ]

    --
    -- * Case insensitive name lookups
    --

    -- | Does a case-insensitive search by package name.
    --
    -- If there is only one package that compares case-insensitively to this name
    -- then the search is unambiguous and we get back all versions of that package.
    -- If several match case-insensitively but one matches exactly then it is also
    -- unambiguous.
    --
    -- If however several match case-insensitively and none match exactly then we
    -- have an ambiguous result, and we get back all the versions of all the
    -- packages. The list of ambiguous results is split by exact package name. So
    -- it is a non-empty list of non-empty lists.
    --
    searchByName :: PackageInstalled a => PackageIndex a -> String -> SearchResult [a]
    searchByName (PackageIndex _ pnames) name =
      case [ pkgs | pkgs@(PackageName name',_) <- Map.toList pnames
                  , lowercase name' == lname ] of
        []               -> None
        [(_,pvers)]      -> Unambiguous (concat (Map.elems pvers))
        pkgss            -> case find ((PackageName name==) . fst) pkgss of
          Just (_,pvers) -> Unambiguous (concat (Map.elems pvers))
          Nothing        -> Ambiguous (map (concat . Map.elems . snd) pkgss)
      where lname = lowercase 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.
    --
    searchByNameSubstring :: PackageInstalled a => PackageIndex a -> String -> [a]
    searchByNameSubstring (PackageIndex _ pnames) searchterm =
      [ pkg
      | (PackageName name, pvers) <- Map.toList pnames
      , lsearchterm `isInfixOf` lowercase name
      , pkgs <- Map.elems pvers
      , pkg <- pkgs ]
      where lsearchterm = lowercase searchterm

    --
    -- * Special queries
    --

    -- None of the stuff below depends on the internal representation of the index.
    --

    -- | Find if there are any cycles in the dependency graph. If there are no
    -- cycles the result is @[]@.
    --
    -- This actually computes the strongly connected components. So it gives us a
    -- list of groups of packages where within each group they all depend on each
    -- other, directly or indirectly.
    --
    dependencyCycles :: PackageInstalled a => PackageIndex a -> [[a]]
    dependencyCycles = dependencyCycles' Map.empty

    -- | Variant of 'dependencyCycles' which accepts a 'FakeMap'.  See Note [FakeMap].
    dependencyCycles' :: PackageInstalled a => FakeMap -> PackageIndex a -> [[a]]
    dependencyCycles' fakeMap index =
      [ vs | Graph.CyclicSCC vs <- Graph.stronglyConnComp adjacencyList ]
      where
        adjacencyList = [ (pkg, installedPackageId pkg, fakeInstalledDepends fakeMap pkg)
                        | pkg <- allPackages index ]

    -- | All packages that have immediate dependencies that are not in the index.
    --
    -- Returns such packages along with the dependencies that they're missing.
    --
    brokenPackages :: PackageInstalled a => PackageIndex a -> [(a, [InstalledPackageId])]
    brokenPackages = brokenPackages' Map.empty

    -- | Variant of 'brokenPackages' which accepts a 'FakeMap'.  See Note [FakeMap].
    brokenPackages' :: PackageInstalled a => FakeMap -> PackageIndex a -> [(a, [InstalledPackageId])]
    brokenPackages' fakeMap index =
      [ (pkg, missing)
      | pkg  <- allPackages index
      , let missing = [ pkg' | pkg' <- installedDepends pkg
                             , isNothing (fakeLookupInstalledPackageId fakeMap index pkg') ]
      , not (null missing) ]

    -- | Variant of 'lookupInstalledPackageId' which accepts a 'FakeMap'.  See Note [FakeMap].
    fakeLookupInstalledPackageId :: PackageInstalled a => FakeMap -> PackageIndex a -> InstalledPackageId -> Maybe a
    fakeLookupInstalledPackageId fakeMap index pkg = lookupInstalledPackageId index (Map.findWithDefault pkg pkg fakeMap)

    -- | Tries to take the transitive closure of the package dependencies.
    --
    -- If the transitive closure is complete then it returns that subset of the
    -- index. Otherwise it returns the broken packages as in 'brokenPackages'.
    --
    -- * Note that if the result is @Right []@ it is because at least one of
    -- the original given 'PackageId's do not occur in the index.
    --
    dependencyClosure :: PackageInstalled a => PackageIndex a
                      -> [InstalledPackageId]
                      -> Either (PackageIndex a)
                                [(a, [InstalledPackageId])]
    dependencyClosure = dependencyClosure' Map.empty

    -- | Variant of 'dependencyClosure' which accepts a 'FakeMap'.  See Note [FakeMap].
    dependencyClosure' :: PackageInstalled a => FakeMap
                      -> PackageIndex a
                      -> [InstalledPackageId]
                      -> Either (PackageIndex a)
                                [(a, [InstalledPackageId])]
    dependencyClosure' fakeMap index pkgids0 = case closure mempty [] pkgids0 of
      (completed, []) -> Left completed
      (completed, _)  -> Right (brokenPackages completed)
     where
        closure completed failed []             = (completed, failed)
        closure completed failed (pkgid:pkgids) = case fakeLookupInstalledPackageId fakeMap index pkgid of
          Nothing   -> closure completed (pkgid:failed) pkgids
          Just pkg  -> case fakeLookupInstalledPackageId fakeMap completed (installedPackageId pkg) of
            Just _  -> closure completed  failed pkgids
            Nothing -> closure completed' failed pkgids'
              where completed' = insert pkg completed
                    pkgids'    = installedDepends pkg ++ pkgids

    -- | Takes the transitive closure of the packages reverse dependencies.
    --
    -- * The given 'PackageId's must be in the index.
    --
    reverseDependencyClosure :: PackageInstalled a => PackageIndex a
                             -> [InstalledPackageId]
                             -> [a]
    reverseDependencyClosure = reverseDependencyClosure' Map.empty

    -- | Variant of 'reverseDependencyClosure' which accepts a 'FakeMap'.  See Note [FakeMap].
    reverseDependencyClosure' :: PackageInstalled a => FakeMap
                             -> PackageIndex a
                             -> [InstalledPackageId]
                             -> [a]
    reverseDependencyClosure' fakeMap index =
        map vertexToPkg
      . concatMap Tree.flatten
      . Graph.dfs reverseDepGraph
      . map (fromMaybe noSuchPkgId . pkgIdToVertex)

      where
        (depGraph, vertexToPkg, pkgIdToVertex) = dependencyGraph' fakeMap index
        reverseDepGraph = Graph.transposeG depGraph
        noSuchPkgId = error "reverseDependencyClosure: package is not in the graph"

    topologicalOrder :: PackageInstalled a => PackageIndex a -> [a]
    topologicalOrder index = map toPkgId
                           . Graph.topSort
                           $ graph
      where (graph, toPkgId, _) = dependencyGraph index

    reverseTopologicalOrder :: PackageInstalled a => PackageIndex a -> [a]
    reverseTopologicalOrder index = map toPkgId
                                  . Graph.topSort
                                  . Graph.transposeG
                                  $ graph
      where (graph, toPkgId, _) = dependencyGraph index

    -- | Builds a graph of the package dependencies.
    --
    -- Dependencies on other packages that are not in the index are discarded.
    -- You can check if there are any such dependencies with 'brokenPackages'.
    --
    dependencyGraph :: PackageInstalled a => PackageIndex a
                    -> (Graph.Graph,
                        Graph.Vertex -> a,
                        InstalledPackageId -> Maybe Graph.Vertex)
    dependencyGraph = dependencyGraph' Map.empty

    -- | Variant of 'dependencyGraph' which accepts a 'FakeMap'.  See Note [FakeMap].
    dependencyGraph' :: PackageInstalled a => FakeMap
                    -> PackageIndex a
                    -> (Graph.Graph,
                        Graph.Vertex -> a,
                        InstalledPackageId -> Maybe Graph.Vertex)
    dependencyGraph' fakeMap index = (graph, vertex_to_pkg, id_to_vertex)
      where
        graph = Array.listArray bounds
                  [ [ v | Just v <- map id_to_vertex (installedDepends pkg) ]
                  | pkg <- pkgs ]

        pkgs             = sortBy (comparing packageId) (allPackages index)
        vertices         = zip (map installedPackageId pkgs) [0..]
        vertex_map       = Map.fromList vertices
        id_to_vertex pid = Map.lookup (Map.findWithDefault pid pid fakeMap) vertex_map

        vertex_to_pkg vertex = pkgTable ! vertex

        pkgTable   = Array.listArray bounds pkgs
        topBound = length pkgs - 1
        bounds = (0, topBound)

    -- | 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
    -- if the dependencies within it use consistent versions of each package.
    -- Return all cases where multiple packages depend on different versions of
    -- some other package.
    --
    -- Each element in the result is a package name along with the packages that
    -- depend on it and the versions they require. These are guaranteed to be
    -- distinct.
    --
    dependencyInconsistencies :: PackageInstalled a => PackageIndex a
                              -> [(PackageName, [(PackageId, Version)])]
    dependencyInconsistencies = dependencyInconsistencies' Map.empty

    -- | Variant of 'dependencyInconsistencies' which accepts a 'FakeMap'.  See Note [FakeMap].
    dependencyInconsistencies' :: PackageInstalled a => FakeMap -> PackageIndex a
                              -> [(PackageName, [(PackageId, Version)])]
    dependencyInconsistencies' fakeMap index =
      [ (name, [ (pid,packageVersion dep) | (dep,pids) <- uses, pid <- pids])
      | (name, ipid_map) <- Map.toList inverseIndex
      , let uses = Map.elems ipid_map
      , reallyIsInconsistent (map fst uses) ]

      where -- for each PackageName,
            --   for each package with that name,
            --     the InstalledPackageInfo and the package Ids of packages
            --     that depend on it.
            inverseIndex = Map.fromListWith (Map.unionWith (\(a,b) (_,b') -> (a,b++b')))
              [ (packageName dep,
                 Map.fromList [(ipid,(dep,[packageId pkg]))])
              | pkg <- allPackages index
              , ipid <- fakeInstalledDepends fakeMap pkg
              , Just dep <- [fakeLookupInstalledPackageId fakeMap index ipid]
              ]

            reallyIsInconsistent :: PackageInstalled a => [a] -> Bool
            reallyIsInconsistent []       = False
            reallyIsInconsistent [_p]     = False
            reallyIsInconsistent [p1, p2] =
              let pid1 = installedPackageId p1
                  pid2 = installedPackageId p2
              in Map.findWithDefault pid1 pid1 fakeMap `notElem` fakeInstalledDepends fakeMap p2
              && Map.findWithDefault pid2 pid2 fakeMap `notElem` fakeInstalledDepends fakeMap p1
            reallyIsInconsistent _ = True

    -- | Variant of 'installedDepends' which accepts a 'FakeMap'.  See Note [FakeMap].
    fakeInstalledDepends :: PackageInstalled a => FakeMap -> a -> [InstalledPackageId]
    fakeInstalledDepends fakeMap = map (\pid -> Map.findWithDefault pid pid fakeMap) . installedDepends

    -- | A rough approximation of GHC's module finder, takes a 'InstalledPackageIndex' and
    -- turns it into a map from module names to their source packages.  It's used to
    -- initialize the @build-deps@ field in @cabal init@.
    moduleNameIndex :: InstalledPackageIndex -> Map ModuleName [InstalledPackageInfo]
    moduleNameIndex index =
      Map.fromListWith (++) $ do
        pkg <- allPackages index
        IPI.ExposedModule m reexport _ <- IPI.exposedModules pkg
        case reexport of
            Nothing -> return (m, [pkg])
            Just (IPI.OriginalModule _ m') | m == m'   -> []
                                           | otherwise -> return (m', [pkg])
            -- The heuristic is this: we want to prefer the original package
            -- which originally exported a module.  However, if a reexport
            -- also *renamed* the module (m /= m'), then we have to use the
            -- downstream package, since the upstream package has the wrong
            -- module name!