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
-- ---------------------------------------------------------------------------
-- | 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
initPackages dflags = do
pkg_db <- case pkgDatabase dflags of
Nothing -> readPackageConfigs dflags
- Just db -> return db
+ Just db -> return $ maybeHidePackages dflags db
(pkg_state, preload, this_pkg)
<- mkPackageState dflags pkg_db [] (thisPackage dflags)
return (dflags{ pkgDatabase = Just pkg_db,
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
packageFlagErr :: PackageFlag
-> [(PackageConfig, UnusablePackageReason)]
-> IO a
+
+-- for missing DPH package we emit a more helpful error message, because
+-- this may be the result of using -fdph-par or -fdph-seq.
+packageFlagErr (ExposePackage pkg) [] | is_dph_package pkg
+ = ghcError (CmdLineError (showSDoc $ dph_err))
+ where dph_err = text "the " <> text pkg <> text " package is not installed."
+ $$ text "To install it: \"cabal install dph\"."
+ is_dph_package pkg = "dph" `isPrefixOf` pkg
+
packageFlagErr flag reasons = ghcError (CmdLineError (showSDoc $ err))
where err = text "cannot satisfy " <> ppr_flag <>
(if null reasons then empty else text ": ") $$
integerPackageId,
basePackageId,
rtsPackageId,
- haskell98PackageId,
thPackageId,
dphSeqPackageId,
dphParPackageId ]
| 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
-- -----------------------------------------------------------------------------
where pid = installedPackageId p
-- XXX this is just a variant of nub
- ipid_map = listToFM [ (installedPackageId p, p) | p <- pkgs0 ]
+ 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)
-- | Will the 'Name' come from a dynamically linked library?
isDllName :: PackageId -> Name -> Bool
+-- Despite the "dll", I think this function just means that
+-- the synbol comes from another dynamically-linked package,
+-- and applies on all platforms, not just Windows
isDllName this_pkg name
| opt_Static = False
| Just mod <- nameModule_maybe name = modulePackageId mod /= this_pkg