#include "HsVersions.h"
import PackageConfig
-import ParsePkgConf ( loadPackageConfig )
import DynFlags ( dopt, DynFlag(..), DynFlags(..), PackageFlag(..) )
import StaticFlags
import Config ( cProjectVersion )
import Name ( Name, nameModule_maybe )
import UniqFM
-import FiniteMap
import Module
import Util
import Panic
import System.Environment ( getEnv )
import Distribution.InstalledPackageInfo
+import Distribution.InstalledPackageInfo.Binary
import Distribution.Package hiding (PackageId,depends)
import FastString
import ErrUtils ( debugTraceMsg, putMsg, Message )
import System.FilePath
import Control.Monad
import Data.List as List
+import Data.Map (Map)
+import qualified Data.Map as Map
+import qualified FiniteMap as Map
+import qualified Data.Set as Set
-- ---------------------------------------------------------------------------
-- The Package state
-- PackageConfig for the package containing the module, and
-- exposed is True if the package exposes that module.
- installedPackageIdMap :: FiniteMap InstalledPackageId PackageId
+ installedPackageIdMap :: InstalledPackageIdMap
}
-- | A PackageConfigMap maps a 'PackageId' to a 'PackageConfig'
type PackageConfigMap = UniqFM PackageConfig
+type InstalledPackageIdMap = Map InstalledPackageId PackageId
+
+type InstalledPackageIndex = Map InstalledPackageId PackageConfig
+
emptyPackageConfigMap :: PackageConfigMap
emptyPackageConfigMap = emptyUFM
-- -----------------------------------------------------------------------------
-- Reading the package database(s)
-readPackageConfigs :: DynFlags -> IO PackageConfigMap
+readPackageConfigs :: DynFlags -> IO [PackageConfig]
readPackageConfigs dflags = do
e_pkg_path <- tryIO (getEnv "GHC_PACKAGE_PATH")
system_pkgconfs <- getSystemPackageConfigs dflags
-- if the path ends in a separator (eg. "/foo/bar:")
-- the we tack on the system paths.
- -- Read all the ones mentioned in -package-conf flags
- pkg_map <- foldM (readPackageConfig dflags) emptyPackageConfigMap
- (reverse pkgconfs ++ extraPkgConfs dflags)
+ pkgs <- mapM (readPackageConfig dflags)
+ (pkgconfs ++ reverse (extraPkgConfs dflags))
+ -- later packages shadow earlier ones. extraPkgConfs
+ -- is in the opposite order to the flags on the
+ -- command line.
- return pkg_map
+ return (concat pkgs)
getSystemPackageConfigs :: DynFlags -> IO [FilePath]
-- System one always comes first
let system_pkgconf = systemPackageConfig dflags
- -- allow package.conf.d to contain a bunch of .conf files
- -- containing package specifications. This is an easier way
- -- to maintain the package database on systems with a package
- -- management system, or systems that don't want to run ghc-pkg
- -- to register or unregister packages. Undocumented feature for now.
- let system_pkgconf_dir = system_pkgconf <.> "d"
- system_pkgconf_dir_exists <- doesDirectoryExist system_pkgconf_dir
- system_pkgconfs <-
- if system_pkgconf_dir_exists
- then do files <- getDirectoryContents system_pkgconf_dir
- return [ system_pkgconf_dir </> file
- | file <- files
- , takeExtension file == ".conf" ]
- else return []
-
-- Read user's package conf (eg. ~/.ghc/i386-linux-6.3/package.conf)
-- unless the -no-user-package-conf flag was given.
- -- We only do this when getAppUserDataDirectory is available
- -- (GHC >= 6.3).
user_pkgconf <- do
+ if not (dopt Opt_ReadUserPackageConf dflags) then return [] else do
appdir <- getAppUserDataDirectory "ghc"
let
- pkgconf = appdir
- </> (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion)
- </> "package.conf"
- flg <- doesFileExist pkgconf
- if (flg && dopt Opt_ReadUserPackageConf dflags)
- then return [pkgconf]
- else return []
+ dir = appdir </> (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion)
+ pkgconf = dir </> "package.conf.d"
+ --
+ exist <- doesDirectoryExist pkgconf
+ if exist then return [pkgconf] else return []
`catchIO` (\_ -> return [])
- return (user_pkgconf ++ system_pkgconfs ++ [system_pkgconf])
+ return (system_pkgconf : user_pkgconf)
+readPackageConfig :: DynFlags -> FilePath -> IO [PackageConfig]
+readPackageConfig dflags conf_file = do
+ isdir <- doesDirectoryExist conf_file
-readPackageConfig
- :: DynFlags -> PackageConfigMap -> FilePath -> IO PackageConfigMap
-readPackageConfig dflags pkg_map conf_file = do
- debugTraceMsg dflags 2 (text "Using package config file:" <+> text conf_file)
- proto_pkg_configs <- loadPackageConfig dflags conf_file
- let top_dir = topDir dflags
+ proto_pkg_configs <-
+ if isdir
+ then do let filename = conf_file </> "package.cache"
+ debugTraceMsg dflags 2 (text "Using binary package database:" <+> text filename)
+ conf <- readBinPackageDB filename
+ return (map installedPackageInfoToPackageConfig conf)
+
+ else do
+ isfile <- doesFileExist conf_file
+ when (not isfile) $
+ ghcError $ InstallationError $
+ "can't find a package database at " ++ conf_file
+ debugTraceMsg dflags 2 (text "Using package config file:" <+> text conf_file)
+ str <- readFile conf_file
+ return (map installedPackageInfoToPackageConfig $ read str)
+
+ let
+ top_dir = topDir dflags
pkg_configs1 = mungePackagePaths top_dir proto_pkg_configs
pkg_configs2 = maybeHidePackages dflags pkg_configs1
- return (extendPackageConfigMap pkg_map pkg_configs2)
+ --
+ return pkg_configs2
maybeHidePackages :: DynFlags -> [PackageConfig] -> [PackageConfig]
maybeHidePackages dflags pkgs
-- (-package, -hide-package, -ignore-package).
applyPackageFlag
- :: [PackageConfig] -- Initial database
+ :: UnusablePackages
+ -> [PackageConfig] -- Initial database
-> PackageFlag -- flag to apply
-> IO [PackageConfig] -- new database
-applyPackageFlag pkgs flag =
+applyPackageFlag unusable pkgs flag =
case flag of
- ExposePackage str ->
- case matchingPackages str pkgs of
- Nothing -> missingPackageErr str
- Just ([], _) -> panic "applyPackageFlag"
- Just (p:ps,qs) -> return (p':ps')
- where p' = p {exposed=True}
- ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs)
-
- HidePackage str ->
- case matchingPackages str pkgs of
- Nothing -> missingPackageErr str
- Just (ps,qs) -> return (map hide ps ++ qs)
- where hide p = p {exposed=False}
-
- IgnorePackage str ->
- case matchingPackages str pkgs of
- Nothing -> return pkgs
- Just (_, qs) -> return qs
- -- missing package is not an error for -ignore-package,
- -- because a common usage is to -ignore-package P as
- -- a preventative measure just in case P exists.
+ ExposePackage str ->
+ case selectPackages (matchingStr str) pkgs unusable of
+ Left ps -> packageFlagErr flag ps
+ Right (p:ps,qs) -> return (p':ps')
+ where p' = p {exposed=True}
+ ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs)
+ _ -> panic "applyPackageFlag"
+
+ ExposePackageId str ->
+ case selectPackages (matchingId str) pkgs unusable of
+ Left ps -> packageFlagErr flag ps
+ Right (p:ps,qs) -> return (p':ps')
+ where p' = p {exposed=True}
+ ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs)
+ _ -> panic "applyPackageFlag"
+
+ HidePackage str ->
+ case selectPackages (matchingStr str) pkgs unusable of
+ Left ps -> packageFlagErr flag ps
+ Right (ps,qs) -> return (map hide ps ++ qs)
+ where hide p = p {exposed=False}
+
+ _ -> panic "applyPackageFlag"
+
where
-- When a package is requested to be exposed, we hide all other
-- packages with the same name.
| otherwise = p
-matchingPackages :: String -> [PackageConfig]
- -> Maybe ([PackageConfig], [PackageConfig])
-matchingPackages str pkgs
- = case partition (packageMatches str) pkgs of
- ([],_) -> Nothing
- (ps,rest) -> Just (sortByVersion ps, rest)
+selectPackages :: (PackageConfig -> Bool) -> [PackageConfig]
+ -> UnusablePackages
+ -> Either [(PackageConfig, UnusablePackageReason)]
+ ([PackageConfig], [PackageConfig])
+selectPackages matches pkgs unusable
+ = let
+ (ps,rest) = partition matches pkgs
+ reasons = [ (p, Map.lookup (installedPackageId p) unusable)
+ | p <- ps ]
+ in
+ if all (isJust.snd) reasons
+ then Left [ (p, reason) | (p,Just reason) <- reasons ]
+ else Right (sortByVersion [ p | (p,Nothing) <- reasons ], rest)
-- A package named on the command line can either include the
-- version, or just the name if it is unambiguous.
-packageMatches :: String -> PackageConfig -> Bool
-packageMatches str p
+matchingStr :: String -> PackageConfig -> Bool
+matchingStr str p
= str == display (sourcePackageId p)
|| str == display (pkgName (sourcePackageId p))
-pickPackages :: [PackageConfig] -> [String] -> [PackageConfig]
-pickPackages pkgs strs =
- [ p | p <- strs, Just (p:_, _) <- [matchingPackages p pkgs] ]
+matchingId :: String -> PackageConfig -> Bool
+matchingId str p = InstalledPackageId str == installedPackageId p
sortByVersion :: [InstalledPackageInfo_ m] -> [InstalledPackageInfo_ m]
sortByVersion = sortBy (flip (comparing (pkgVersion.sourcePackageId)))
comparing :: Ord a => (t -> a) -> t -> t -> Ordering
comparing f a b = f a `compare` f b
+packageFlagErr :: PackageFlag
+ -> [(PackageConfig, UnusablePackageReason)]
+ -> IO a
+packageFlagErr flag reasons = ghcError (CmdLineError (showSDoc $ err))
+ where err = text "cannot satisfy " <> ppr_flag <>
+ (if null reasons then empty else text ": ") $$
+ nest 4 (ppr_reasons $$
+ text "(use -v for more information)")
+ ppr_flag = case flag of
+ IgnorePackage p -> text "-ignore-package " <> text p
+ HidePackage p -> text "-hide-package " <> text p
+ ExposePackage p -> text "-package " <> text p
+ ExposePackageId p -> text "-package-id " <> text p
+ ppr_reasons = vcat (map ppr_reason reasons)
+ ppr_reason (p, reason) = pprReason (pprIPkg p <+> text "is") reason
+
-- -----------------------------------------------------------------------------
-- Hide old versions of packages
| not (exposed p) = return p
| (p' : _) <- later_versions = do
debugTraceMsg dflags 2 $
- (ptext (sLit "hiding package") <+>
- text (display (sourcePackageId p)) <+>
+ (ptext (sLit "hiding package") <+> pprSPkg p <+>
ptext (sLit "to avoid conflict with later version") <+>
- text (display (sourcePackageId p')))
+ pprSPkg p')
return (p {exposed=False})
| otherwise = return p
where myname = pkgName (sourcePackageId p)
ptext (sLit "wired-in package ")
<> text wired_pkg
<> ptext (sLit " mapped to ")
- <> text (display (sourcePackageId pkg))
+ <> pprIPkg pkg
return (Just (installedPackageId pkg))
return $ updateWiredInDependencies pkgs
-- ----------------------------------------------------------------------------
+
+data UnusablePackageReason
+ = IgnoredWithFlag
+ | MissingDependencies [InstalledPackageId]
+ | ShadowedBy InstalledPackageId
+
+type UnusablePackages = Map InstalledPackageId UnusablePackageReason
+
+pprReason :: SDoc -> UnusablePackageReason -> SDoc
+pprReason pref reason = case reason of
+ IgnoredWithFlag ->
+ pref <+> ptext (sLit "ignored due to an -ignore-package flag")
+ MissingDependencies deps ->
+ pref <+>
+ ptext (sLit "unusable due to missing or recursive dependencies:") $$
+ nest 2 (hsep (map (text.display) deps))
+ ShadowedBy ipid ->
+ pref <+> ptext (sLit "shadowed by package ") <> text (display ipid)
+
+reportUnusable :: DynFlags -> UnusablePackages -> IO ()
+reportUnusable dflags pkgs = mapM_ report (Map.toList pkgs)
+ where
+ report (ipid, reason) =
+ debugTraceMsg dflags 2 $
+ pprReason
+ (ptext (sLit "package") <+>
+ text (display ipid) <+> text "is") reason
+
+-- ----------------------------------------------------------------------------
--
-- Detect any packages that have missing dependencies, and also any
-- mutually-recursive groups of packages (loops in the package graph
-- dependency graph, repeatedly adding packages whose dependencies are
-- satisfied until no more can be added.
--
-elimDanglingDeps
- :: DynFlags
- -> [PackageConfig]
- -> [PackageId] -- ignored packages
- -> IO [PackageConfig]
-
-elimDanglingDeps dflags pkgs ignored = go [] pkgs'
+findBroken :: [PackageConfig] -> UnusablePackages
+findBroken pkgs = go [] Map.empty pkgs
where
- pkgs' = filter (\p -> packageConfigId p `notElem` ignored) pkgs
-
- go avail not_avail =
- case partitionWith (depsAvailable avail) not_avail of
- ([], not_avail) -> do mapM_ reportElim not_avail; return avail
- (new_avail, not_avail) -> go (new_avail ++ avail) (map fst not_avail)
-
- depsAvailable :: [PackageConfig] -> PackageConfig
+ go avail ipids not_avail =
+ case partitionWith (depsAvailable ipids) not_avail of
+ ([], not_avail) ->
+ Map.fromList [ (installedPackageId p, MissingDependencies deps)
+ | (p,deps) <- not_avail ]
+ (new_avail, not_avail) ->
+ go (new_avail ++ avail) new_ipids (map fst not_avail)
+ where new_ipids = Map.insertList
+ [ (installedPackageId p, p) | p <- new_avail ]
+ ipids
+
+ depsAvailable :: InstalledPackageIndex
+ -> PackageConfig
-> Either PackageConfig (PackageConfig, [InstalledPackageId])
- depsAvailable pkgs_ok pkg
+ depsAvailable ipids pkg
| null dangling = Left pkg
| otherwise = Right (pkg, dangling)
- where dangling = filter (`notElem` pids) (depends pkg)
- pids = map installedPackageId pkgs_ok
+ where dangling = filter (not . (`Map.member` ipids)) (depends pkg)
- reportElim (p, deps) =
- debugTraceMsg dflags 2 $
- (ptext (sLit "package") <+> pprPkg p <+>
- ptext (sLit "will be ignored due to missing or recursive dependencies:") $$
- nest 2 (hsep (map (text.display) deps)))
+-- -----------------------------------------------------------------------------
+-- Eliminate shadowed packages, giving the user some feedback
+
+-- later packages in the list should shadow earlier ones with the same
+-- package name/version. Additionally, a package may be preferred if
+-- it is in the transitive closure of packages selected using -package-id
+-- flags.
+shadowPackages :: [PackageConfig] -> [InstalledPackageId] -> UnusablePackages
+shadowPackages pkgs preferred
+ = let (shadowed,_) = foldl check ([],emptyUFM) pkgs
+ in Map.fromList shadowed
+ where
+ check (shadowed,pkgmap) pkg
+ | Just oldpkg <- lookupUFM pkgmap (packageConfigId pkg)
+ , let
+ ipid_new = installedPackageId pkg
+ ipid_old = installedPackageId oldpkg
+ --
+ , ipid_old /= ipid_new
+ = if ipid_old `elem` preferred
+ then ( (ipid_new, ShadowedBy ipid_old) : shadowed, pkgmap )
+ else ( (ipid_old, ShadowedBy ipid_new) : shadowed, pkgmap' )
+ | otherwise
+ = (shadowed, pkgmap')
+ where
+ pkgmap' = addToUFM pkgmap (packageConfigId pkg) pkg
+
+-- -----------------------------------------------------------------------------
+
+ignorePackages :: [PackageFlag] -> [PackageConfig] -> UnusablePackages
+ignorePackages flags pkgs = Map.fromList (concatMap doit flags)
+ where
+ doit (IgnorePackage str) =
+ case partition (matchingStr str) pkgs of
+ (ps, _) -> [ (installedPackageId p, IgnoredWithFlag)
+ | p <- ps ]
+ -- missing package is not an error for -ignore-package,
+ -- because a common usage is to -ignore-package P as
+ -- a preventative measure just in case P exists.
+ doit _ = panic "ignorePackages"
+
+-- -----------------------------------------------------------------------------
+
+depClosure :: InstalledPackageIndex
+ -> [InstalledPackageId]
+ -> [InstalledPackageId]
+depClosure index ipids = closure Map.empty ipids
+ where
+ closure set [] = Map.keys set
+ closure set (ipid : ipids)
+ | ipid `Map.member` set = closure set ipids
+ | Just p <- Map.lookup ipid index = closure (Map.insert ipid p set)
+ (depends p ++ ipids)
+ | otherwise = closure set ipids
-- -----------------------------------------------------------------------------
-- When all the command-line options are in, we can process our package
mkPackageState
:: DynFlags
- -> PackageConfigMap -- initial database
+ -> [PackageConfig] -- initial database
-> [PackageId] -- preloaded packages
-> PackageId -- this package
-> IO (PackageState,
-- package is a wired-in package.
-mkPackageState dflags orig_pkg_db preload0 this_package = do
+mkPackageState dflags pkgs0 preload0 this_package = do
+
+{-
+ Plan.
+
+ 1. P = transitive closure of packages selected by -package-id
+
+ 2. Apply shadowing. When there are multiple packages with the same
+ sourcePackageId,
+ * if one is in P, use that one
+ * otherwise, use the one highest in the package stack
+ [
+ rationale: we cannot use two packages with the same sourcePackageId
+ in the same program, because sourcePackageId is the symbol prefix.
+ Hence we must select a consistent set of packages to use. We have
+ a default algorithm for doing this: packages higher in the stack
+ shadow those lower down. This default algorithm can be overriden
+ by giving explicit -package-id flags; then we have to take these
+ preferences into account when selecting which other packages are
+ made available.
+
+ Our simple algorithm throws away some solutions: there may be other
+ consistent sets that would satisfy the -package flags, but it's
+ not GHC's job to be doing constraint solving.
+ ]
+
+ 3. remove packages selected by -ignore-package
+
+ 4. remove any packages with missing dependencies, or mutually recursive
+ dependencies.
+
+ 5. report (with -v) any packages that were removed by steps 2-4
+
+ 6. apply flags to set exposed/hidden on the resulting packages
+ - if any flag refers to a package which was removed by 2-4, then
+ we can give an error message explaining why
+
+ 7. hide any packages which are superseded by later exposed packages
+-}
+
+ let
+ flags = reverse (packageFlags dflags)
+
+ -- pkgs0 with duplicate packages filtered out. This is
+ -- important: it is possible for a package in the global package
+ -- DB to have the same IPID as a package in the user DB, and
+ -- we want the latter to take precedence. This is not the same
+ -- as shadowing (below), since in this case the two packages
+ -- have the same ABI and are interchangeable.
+ --
+ -- #4072: note that we must retain the ordering of the list here
+ -- so that shadowing behaves as expected when we apply it later.
+ pkgs0_unique = snd $ foldr del (Set.empty,[]) pkgs0
+ where del p (s,ps)
+ | pid `Set.member` s = (s,ps)
+ | otherwise = (Set.insert pid s, p:ps)
+ where pid = installedPackageId p
+ -- XXX this is just a variant of nub
+
+ ipid_map = Map.fromList [ (installedPackageId p, p) | p <- pkgs0 ]
+
+ ipid_selected = depClosure ipid_map [ InstalledPackageId i
+ | ExposePackageId i <- flags ]
+
+ (ignore_flags, other_flags) = partition is_ignore flags
+ is_ignore IgnorePackage{} = True
+ is_ignore _ = False
+
+ shadowed = shadowPackages pkgs0_unique ipid_selected
+
+ ignored = ignorePackages ignore_flags pkgs0_unique
+
+ pkgs0' = filter (not . (`Map.member` (Map.union shadowed ignored)) . installedPackageId) pkgs0_unique
+ broken = findBroken pkgs0'
+ unusable = shadowed `Map.union` ignored `Map.union` broken
+
+ reportUnusable dflags unusable
+
--
-- Modify the package database according to the command-line flags
-- (-package, -hide-package, -ignore-package, -hide-all-packages).
--
- let flags = reverse (packageFlags dflags)
- let pkgs0 = eltsUFM orig_pkg_db
- pkgs1 <- foldM applyPackageFlag pkgs0 flags
+ pkgs1 <- foldM (applyPackageFlag unusable) pkgs0_unique other_flags
+ let pkgs2 = filter (not . (`Map.member` unusable) . installedPackageId) pkgs1
-- Here we build up a set of the packages mentioned in -package
-- flags on the command line; these are called the "preload"
-- should contain at least rts & base, which is why we pretend that
-- the command line contains -package rts & -package base.
--
- let preload1 = map installedPackageId $
- pickPackages pkgs0 [ p | ExposePackage p <- flags ]
+ let preload1 = [ installedPackageId p | f <- flags, p <- get_exposed f ]
+
+ get_exposed (ExposePackage s) = filter (matchingStr s) pkgs2
+ get_exposed (ExposePackageId s) = filter (matchingId s) pkgs2
+ get_exposed _ = []
-- hide packages that are subsumed by later versions
- pkgs2 <- hideOldPackages dflags pkgs1
+ pkgs3 <- hideOldPackages dflags pkgs2
-- sort out which packages are wired in
- pkgs3 <- findWiredInPackages dflags pkgs2
+ pkgs4 <- findWiredInPackages dflags pkgs3
- let ignored = map packageConfigId $
- pickPackages pkgs0 [ p | IgnorePackage p <- flags ]
- pkgs <- elimDanglingDeps dflags pkgs3 ignored
+ let pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs4
- let pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs
-
- ipid_map = listToFM [ (installedPackageId p, packageConfigId p)
- | p <- pkgs ]
+ ipid_map = Map.fromList [ (installedPackageId p, packageConfigId p)
+ | p <- pkgs4 ]
lookupIPID ipid@(InstalledPackageId str)
- | Just pid <- lookupFM ipid_map ipid = return pid
- | otherwise = missingPackageErr str
+ | Just pid <- Map.lookup ipid ipid_map = return pid
+ | otherwise = missingPackageErr str
preload2 <- mapM lookupIPID preload1
exposed_mods = exposedModules pkg
hidden_mods = hiddenModules pkg
-pprPkg :: PackageConfig -> SDoc
-pprPkg p = text (display (sourcePackageId p))
+pprSPkg :: PackageConfig -> SDoc
+pprSPkg p = text (display (sourcePackageId p))
+
+pprIPkg :: PackageConfig -> SDoc
+pprIPkg p = text (display (installedPackageId p))
-- -----------------------------------------------------------------------------
-- Extracting information from the packages in scope
packageHsLibs :: DynFlags -> PackageConfig -> [String]
packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)
where
- non_dyn_ways = filter ((/= WayDyn) . wayName) (ways dflags)
+ ways0 = ways dflags
+
+ ways1 = filter ((/= WayDyn) . wayName) ways0
-- the name of a shared library is libHSfoo-ghc<version>.so
-- we leave out the _dyn, because it is superfluous
- tag = mkBuildTag (filter (not . wayRTSOnly) non_dyn_ways)
- rts_tag = mkBuildTag non_dyn_ways
+ -- debug RTS includes support for -eventlog
+ ways2 | WayDebug `elem` map wayName ways1
+ = filter ((/= WayEventLog) . wayName) ways1
+ | otherwise
+ = ways1
+
+ tag = mkBuildTag (filter (not . wayRTSOnly) ways2)
+ rts_tag = mkBuildTag ways2
mkDynName | opt_Static = id
| otherwise = (++ ("-ghc" ++ cProjectVersion))
-- Takes a list of packages, and returns the list with dependencies included,
-- in reverse dependency order (a package appears before those it depends on).
closeDeps :: PackageConfigMap
- -> FiniteMap InstalledPackageId PackageId
+ -> Map InstalledPackageId PackageId
-> [(PackageId, Maybe PackageId)]
-> IO [PackageId]
closeDeps pkg_map ipid_map ps = throwErr (closeDepsErr pkg_map ipid_map ps)
Succeeded r -> return r
closeDepsErr :: PackageConfigMap
- -> FiniteMap InstalledPackageId PackageId
+ -> Map InstalledPackageId PackageId
-> [(PackageId,Maybe PackageId)]
-> MaybeErr Message [PackageId]
closeDepsErr pkg_map ipid_map ps = foldM (add_package pkg_map ipid_map) [] ps
-- internal helper
add_package :: PackageConfigMap
- -> FiniteMap InstalledPackageId PackageId
+ -> Map InstalledPackageId PackageId
-> [PackageId]
-> (PackageId,Maybe PackageId)
-> MaybeErr Message [PackageId]
return (p : ps')
where
add_package_ipid ps ipid@(InstalledPackageId str)
- | Just pid <- lookupFM ipid_map ipid
+ | Just pid <- Map.lookup ipid ipid_map
= add_package pkg_db ipid_map ps (pid, Just p)
| otherwise
= Failed (missingPackageMsg str <> missingDependencyMsg mb_parent)
projects / ghc-hetmet.git / blobdiff