import Config ( cProjectVersion )
import Name ( Name, nameModule_maybe )
import UniqFM
-import FiniteMap
import Module
import Util
import Panic
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
-- | A PackageConfigMap maps a 'PackageId' to a 'PackageConfig'
type PackageConfigMap = UniqFM PackageConfig
-type InstalledPackageIdMap = FiniteMap InstalledPackageId PackageId
+type InstalledPackageIdMap = Map InstalledPackageId PackageId
-type InstalledPackageIndex = FiniteMap InstalledPackageId PackageConfig
+type InstalledPackageIndex = Map InstalledPackageId PackageConfig
emptyPackageConfigMap :: PackageConfigMap
emptyPackageConfigMap = emptyUFM
-- the we tack on the system paths.
pkgs <- mapM (readPackageConfig dflags)
- (reverse pkgconfs ++ reverse (extraPkgConfs dflags))
+ (pkgconfs ++ reverse (extraPkgConfs dflags))
-- later packages shadow earlier ones. extraPkgConfs
-- is in the opposite order to the flags on the
-- command line.
if exist then return [pkgconf] else return []
`catchIO` (\_ -> return [])
- return (user_pkgconf ++ [system_pkgconf])
+ return (system_pkgconf : user_pkgconf)
readPackageConfig :: DynFlags -> FilePath -> IO [PackageConfig]
readPackageConfig dflags conf_file = do
selectPackages matches pkgs unusable
= let
(ps,rest) = partition matches pkgs
- reasons = [ (p, lookupFM unusable (installedPackageId p))
+ reasons = [ (p, Map.lookup (installedPackageId p) unusable)
| p <- ps ]
in
if all (isJust.snd) reasons
| MissingDependencies [InstalledPackageId]
| ShadowedBy InstalledPackageId
-type UnusablePackages = FiniteMap InstalledPackageId UnusablePackageReason
+type UnusablePackages = Map InstalledPackageId UnusablePackageReason
pprReason :: SDoc -> UnusablePackageReason -> SDoc
pprReason pref reason = case reason of
pref <+> ptext (sLit "shadowed by package ") <> text (display ipid)
reportUnusable :: DynFlags -> UnusablePackages -> IO ()
-reportUnusable dflags pkgs = mapM_ report (fmToList pkgs)
+reportUnusable dflags pkgs = mapM_ report (Map.toList pkgs)
where
report (ipid, reason) =
debugTraceMsg dflags 2 $
-- satisfied until no more can be added.
--
findBroken :: [PackageConfig] -> UnusablePackages
-findBroken pkgs = go [] emptyFM pkgs
+findBroken pkgs = go [] Map.empty pkgs
where
go avail ipids not_avail =
case partitionWith (depsAvailable ipids) not_avail of
([], not_avail) ->
- listToFM [ (installedPackageId p, MissingDependencies deps)
- | (p,deps) <- 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 = addListToFM ipids
+ where new_ipids = Map.insertList
[ (installedPackageId p, p) | p <- new_avail ]
+ ipids
depsAvailable :: InstalledPackageIndex
-> PackageConfig
depsAvailable ipids pkg
| null dangling = Left pkg
| otherwise = Right (pkg, dangling)
- where dangling = filter (not . (`elemFM` ipids)) (depends pkg)
+ where dangling = filter (not . (`Map.member` ipids)) (depends pkg)
-- -----------------------------------------------------------------------------
-- Eliminate shadowed packages, giving the user some feedback
shadowPackages :: [PackageConfig] -> [InstalledPackageId] -> UnusablePackages
shadowPackages pkgs preferred
= let (shadowed,_) = foldl check ([],emptyUFM) pkgs
- in listToFM shadowed
+ in Map.fromList shadowed
where
check (shadowed,pkgmap) pkg
| Just oldpkg <- lookupUFM pkgmap (packageConfigId pkg)
-- -----------------------------------------------------------------------------
ignorePackages :: [PackageFlag] -> [PackageConfig] -> UnusablePackages
-ignorePackages flags pkgs = listToFM (concatMap doit flags)
+ignorePackages flags pkgs = Map.fromList (concatMap doit flags)
where
doit (IgnorePackage str) =
case partition (matchingStr str) pkgs of
depClosure :: InstalledPackageIndex
-> [InstalledPackageId]
-> [InstalledPackageId]
-depClosure index ipids = closure emptyFM ipids
+depClosure index ipids = closure Map.empty ipids
where
- closure set [] = keysFM set
+ closure set [] = Map.keys set
closure set (ipid : ipids)
- | ipid `elemFM` set = closure set ipids
- | Just p <- lookupFM index ipid = closure (addToFM set ipid p)
- (depends p ++ 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
-- -----------------------------------------------------------------------------
let
flags = reverse (packageFlags dflags)
- ipid_map = listToFM [ (installedPackageId p, p) | p <- pkgs0 ]
-
-- pkgs0 with duplicate packages filtered out. This is
- -- important: it is possible for a package in the user package
- -- DB to have the same IPID as a package in the global DB, and
- -- we want the former to take precedence. This is not the same
+ -- 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.
- pkgs0_unique = eltsFM ipid_map
+ --
+ -- #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 ]
ignored = ignorePackages ignore_flags pkgs0_unique
- pkgs0' = filter (not . (`elemFM` (plusFM shadowed ignored)) . installedPackageId) pkgs0_unique
+ pkgs0' = filter (not . (`Map.member` (Map.union shadowed ignored)) . installedPackageId) pkgs0_unique
broken = findBroken pkgs0'
- unusable = shadowed `plusFM` ignored `plusFM` broken
+ unusable = shadowed `Map.union` ignored `Map.union` broken
reportUnusable dflags unusable
-- (-package, -hide-package, -ignore-package, -hide-all-packages).
--
pkgs1 <- foldM (applyPackageFlag unusable) pkgs0_unique other_flags
- let pkgs2 = filter (not . (`elemFM` unusable) . installedPackageId) pkgs1
+ 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"
let pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs4
- ipid_map = listToFM [ (installedPackageId p, packageConfigId p)
- | p <- pkgs4 ]
+ 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
-- 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