Commit 6192dbf4 authored by Duncan Coutts's avatar Duncan Coutts Committed by Duncan Coutts

Fix impl of PackageIndex.allPackagesByName

Fixes the problem with generating the haddock documentation contents page for
all installed packages. Previously we were (accidentally) telling haddock to
use all versions of each package and haddock would pick the first (lowest
version). Now we correctly do what we were trying to do all along, which is
to pick only the highest version of each package.
parent dbbb808f
......@@ -43,6 +43,7 @@ module Distribution.Simple.PackageIndex (
-- ** Bulk queries
allPackages,
allPackagesByName,
allPackagesBySourcePackageId,
-- ** Special queries
brokenPackages,
......@@ -293,11 +294,22 @@ allPackages (PackageIndex pids _) = Map.elems pids
-- | Get all the packages from the index.
--
-- They are grouped by package name, case-sensitively.
-- They are grouped by package name (case-sensitively).
--
allPackagesByName :: PackageIndex -> [[InstalledPackageInfo]]
allPackagesByName :: PackageIndex -> [(PackageName, [InstalledPackageInfo])]
allPackagesByName (PackageIndex _ pnames) =
concatMap Map.elems (Map.elems 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 :: PackageIndex -> [(PackageId, [InstalledPackageInfo])]
allPackagesBySourcePackageId (PackageIndex _ pnames) =
[ (packageId ipkg, ipkgs)
| pvers <- Map.elems pnames
, ipkgs@(ipkg:_) <- Map.elems pvers ]
--
-- * Lookups
......
......@@ -12,7 +12,6 @@ import Distribution.InstalledPackageInfo as IPI
import Distribution.Package -- from Cabal
import Distribution.PackageDescription as PD -- from Cabal
import qualified Distribution.Simple.PackageIndex as SI
import Distribution.Simple.Utils (equating)
import Distribution.System
import Distribution.Client.Dependency.Modular.Dependency as D
......@@ -25,9 +24,9 @@ import Distribution.Client.Dependency.Modular.Version
-- | Convert both the installed package index and the source package
-- index into one uniform solver index.
--
-- We use 'allPackagesByName' for the installed package index because
-- that returns us several instances of the same package and version
-- in order of preference. This allows us in principle to "shadow"
-- We use 'allPackagesBySourcePackageId' for the installed package index
-- because that returns us several instances of the same package and version
-- in order of preference. This allows us in principle to \"shadow\"
-- packages if there are several installed packages of the same version.
-- There are currently some shortcomings in both GHC and Cabal in
-- resolving these situations. However, the right thing to do is to
......@@ -41,14 +40,14 @@ convPIs os arch cid sip iidx sidx =
-- | Convert a Cabal installed package index to the simpler,
-- more uniform index format of the solver.
convIPI' :: Bool -> SI.PackageIndex -> [(PN, I, PInfo)]
convIPI' sip idx = combine (convIP idx) . versioned . SI.allPackagesByName $ idx
where
-- group installed packages by version
versioned = L.map (groupBy (equating packageVersion))
convIPI' sip idx =
-- apply shadowing whenever there are multple installed packages with
-- the same version
combine f pkgs = [ g (f p) | pbn <- pkgs, pbv <- pbn,
(g, p) <- zip (id : repeat shadow) pbv ]
[ maybeShadow (convIP idx pkg)
| (_pkgid, pkgs) <- SI.allPackagesBySourcePackageId idx
, (maybeShadow, pkg) <- zip (id : repeat shadow) pkgs ]
where
-- shadowing is recorded in the package info
shadow (pn, i, PInfo fdeps fds encs _) | sip = (pn, i, PInfo fdeps fds encs (Just Shadowed))
shadow x = x
......
......@@ -22,14 +22,15 @@ import Control.Monad (guard)
import System.Directory (createDirectoryIfMissing, doesFileExist,
renameFile)
import System.FilePath ((</>), splitFileName)
import Distribution.Package (Package(..))
import Distribution.Package
( Package(..), packageVersion )
import Distribution.Simple.Program (haddockProgram, ProgramConfiguration
, rawSystemProgram, requireProgramVersion)
import Distribution.Version (Version(Version), orLaterVersion)
import Distribution.Verbosity (Verbosity)
import Distribution.Text (display)
import Distribution.Simple.PackageIndex (PackageIndex, allPackages,
allPackagesByName, fromList)
import Distribution.Simple.PackageIndex
( PackageIndex, allPackagesByName )
import Distribution.Simple.Utils
( comparing, intercalate, debug
, installDirectoryContents, withTempDirectory )
......@@ -64,12 +65,10 @@ regenerateHaddockIndex verbosity pkgs conf index = do
where
(destDir,destFile) = splitFileName index
pkgs' = map (maximumBy $ comparing packageId)
. allPackagesByName
. fromList
. filter exposed
. allPackages
$ pkgs
pkgs' = [ maximumBy (comparing packageVersion) pkgvers'
| (_pname, pkgvers) <- allPackagesByName pkgs
, let pkgvers' = filter exposed pkgvers
, not (null pkgvers') ]
haddockPackagePaths :: [InstalledPackageInfo]
-> IO ([(FilePath, FilePath)], Maybe String)
......
......@@ -51,11 +51,11 @@ import Distribution.Text
import Distribution.Verbosity
( Verbosity, lessVerbose )
import Distribution.Simple.Utils
( die, warn, info, fromUTF8, equating )
( die, warn, info, fromUTF8 )
import Data.Char (isAlphaNum)
import Data.Maybe (catMaybes, fromMaybe)
import Data.List (isPrefixOf, groupBy)
import Data.List (isPrefixOf)
import Data.Monoid (Monoid(..))
import qualified Data.Map as Map
import Control.Monad (MonadPlus(mplus), when, unless, liftM)
......@@ -89,15 +89,14 @@ getInstalledPackages verbosity comp packageDbs conf =
convert :: InstalledPackageIndex.PackageIndex -> PackageIndex InstalledPackage
convert index' = PackageIndex.fromList
-- There can be multiple installed instances of each package version,
-- like when the same package is installed in the global & user dbs.
-- InstalledPackageIndex.allPackagesByName gives us the installed
-- packages with the most preferred instances first, so by picking the
-- first we should get the user one. This is almost but not quite the
-- same as what ghc does.
[ InstalledPackage ipkg (sourceDeps index' ipkg)
| ipkgs <- InstalledPackageIndex.allPackagesByName index'
, (ipkg:_) <- groupBy (equating packageVersion) ipkgs ]
-- There can be multiple installed instances of each package version,
-- like when the same package is installed in the global & user dbs.
-- InstalledPackageIndex.allPackagesBySourcePackageId gives us the
-- installed packages with the most preferred instances first, so by
-- picking the first we should get the user one. This is almost but not
-- quite the same as what ghc does.
[ InstalledPackage ipkg (sourceDeps index' ipkg)
| (_,ipkg:_) <- InstalledPackageIndex.allPackagesBySourcePackageId index' ]
where
-- The InstalledPackageInfo only lists dependencies by the
-- InstalledPackageId, which means we do not directly know the corresponding
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment