- lookupPackageByName :: FastString -> PackageIdH
- lookupPackageByName nm =
- case [ conf | p <- dep_exposed,
- Just conf <- [lookupPackage pkg_db p],
- nm == mkFastString (pkgName (package conf)) ] of
- [] -> HomePackage
- (p:ps) -> ExtPackage (mkPackageId (package p))
-
- -- Get the PackageIds for some known packages (we know the names,
- -- but we don't know the versions). Some of these packages might
- -- not exist in the database, so they are Maybes.
- basePackageId = lookupPackageByName basePackageName
- rtsPackageId = lookupPackageByName rtsPackageName
- haskell98PackageId = lookupPackageByName haskell98PackageName
- thPackageId = lookupPackageByName thPackageName
-
- -- add base & rts to the explicit packages
- basicLinkedPackages = [basePackageId,rtsPackageId]
- explicit' = addListToUniqSet explicit
- [ p | ExtPackage p <- basicLinkedPackages ]
- --
- -- Close the explicit packages with their dependencies
+ wired_in_pkgids = [ basePackageId,
+ rtsPackageId,
+ haskell98PackageId,
+ thPackageId,
+ ndpPackageId ]
+
+ wired_in_names = map packageIdString wired_in_pkgids
+
+ -- find which package corresponds to each wired-in package
+ -- delete any other packages with the same name
+ -- update the package and any dependencies to point to the new
+ -- one.
+ --
+ -- When choosing which package to map to a wired-in package
+ -- name, we prefer exposed packages, and pick the latest
+ -- version. To override the default choice, -hide-package
+ -- could be used to hide newer versions.
+ --
+ findWiredInPackage :: [PackageConfig] -> String
+ -> IO (Maybe PackageIdentifier)
+ findWiredInPackage pkgs wired_pkg =
+ let all_ps = [ p | p <- pkgs, pkgName (package p) == wired_pkg ] in
+ case filter exposed all_ps of
+ [] -> case all_ps of
+ [] -> notfound
+ many -> pick (head (sortByVersion many))
+ many -> pick (head (sortByVersion many))
+ where
+ notfound = do
+ debugTraceMsg dflags 2 $
+ ptext SLIT("wired-in package ")
+ <> text wired_pkg
+ <> ptext SLIT(" not found.")
+ return Nothing
+ pick pkg = do
+ debugTraceMsg dflags 2 $
+ ptext SLIT("wired-in package ")
+ <> text wired_pkg
+ <> ptext SLIT(" mapped to ")
+ <> text (showPackageId (package pkg))
+ return (Just (package pkg))
+
+
+ mb_wired_in_ids <- mapM (findWiredInPackage pkgs) wired_in_names
+ let
+ wired_in_ids = catMaybes mb_wired_in_ids
+
+ deleteOtherWiredInPackages pkgs = filter ok pkgs
+ where ok p = pkgName (package p) `notElem` wired_in_names
+ || package p `elem` wired_in_ids
+
+ updateWiredInDependencies pkgs = map upd_pkg pkgs
+ where upd_pkg p = p{ package = upd_pid (package p),
+ depends = map upd_pid (depends p) }
+
+ upd_pid pid = case filter (== pid) wired_in_ids of
+ [] -> pid
+ (x:_) -> x{ pkgVersion = Version [] [] }
+
+ pkgs1 = deleteOtherWiredInPackages pkgs
+
+ pkgs2 = updateWiredInDependencies pkgs1
+
+ preload1 = map upd_pid preload
+
+ -- we must return an updated thisPackage, just in case we
+ -- are actually compiling one of the wired-in packages
+ Just old_this_pkg = unpackPackageId this_package
+ new_this_pkg = mkPackageId (upd_pid old_this_pkg)
+
+ return (pkgs2, preload1, new_this_pkg)
+
+-- -----------------------------------------------------------------------------
+--
+-- Eliminate any packages which have dangling dependencies (
+-- because the dependency was removed by -ignore-package).
+--
+elimDanglingDeps
+ :: DynFlags
+ -> [PackageConfig]
+ -> [PackageId] -- ignored packages
+ -> IO [PackageConfig]
+
+elimDanglingDeps dflags pkgs ignored =
+ case partition (not.null.snd) (map (getDanglingDeps pkgs ignored) pkgs) of
+ ([],ps) -> return (map fst ps)
+ (ps,qs) -> do
+ mapM_ reportElim ps
+ elimDanglingDeps dflags (map fst qs)
+ (ignored ++ map packageConfigId (map fst ps))
+ where
+ reportElim (p, deps) =
+ debugTraceMsg dflags 2 $
+ (ptext SLIT("package") <+> pprPkg p <+>
+ ptext SLIT("will be ignored due to missing dependencies:") $$
+ nest 2 (hsep (map (text.showPackageId) deps)))
+
+ getDanglingDeps pkgs ignored p = (p, filter dangling (depends p))
+ where dangling pid = mkPackageId pid `elem` ignored
+
+-- -----------------------------------------------------------------------------
+-- When all the command-line options are in, we can process our package
+-- settings and populate the package state.
+
+mkPackageState
+ :: DynFlags
+ -> PackageConfigMap -- initial database
+ -> [PackageId] -- preloaded packages
+ -> PackageId -- this package
+ -> IO (PackageState,
+ [PackageId], -- new packages to preload
+ PackageId) -- this package, might be modified if the current
+
+ -- package is a wired-in package.
+
+mkPackageState dflags orig_pkg_db preload0 this_package = do