% Package manipulation
%
\begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
module Packages (
module PackageConfig,
import Panic
import Outputable
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 603
-import Compat.Directory ( getAppUserDataDirectory )
-#endif
-
import System.Environment ( getEnv )
import Distribution.InstalledPackageInfo
import Distribution.Package
munge_pkg p = p{ importDirs = munge_paths (importDirs p),
includeDirs = munge_paths (includeDirs p),
libraryDirs = munge_paths (libraryDirs p),
- frameworkDirs = munge_paths (frameworkDirs p) }
+ frameworkDirs = munge_paths (frameworkDirs p),
+ haddockInterfaces = munge_paths (haddockInterfaces p),
+ haddockHTMLs = munge_paths (haddockHTMLs p)
+ }
munge_paths = map munge_path
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 (package p)) (ps++qs)
IgnorePackage str ->
case matchingPackages str pkgs of
Nothing -> return pkgs
- Just (ps,qs) -> return qs
+ 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.
= str == showPackageId (package p)
|| str == pkgName (package p)
-
+pickPackages :: [PackageConfig] -> [String] -> [PackageConfig]
pickPackages pkgs strs =
- [ p | p <- strs, Just (p:ps,_) <- [matchingPackages p pkgs] ]
+ [ p | p <- strs, Just (p:_, _) <- [matchingPackages p pkgs] ]
+sortByVersion :: [InstalledPackageInfo_ m] -> [InstalledPackageInfo_ m]
sortByVersion = sortBy (flip (comparing (pkgVersion.package)))
+
+comparing :: Ord a => (t -> a) -> t -> t -> Ordering
comparing f a b = f a `compare` f b
-- -----------------------------------------------------------------------------
-- their canonical names (eg. base-1.0 ==> base).
--
let
- wired_in_pkgids = [ basePackageId,
- rtsPackageId,
- haskell98PackageId,
- thPackageId,
+ wired_in_pkgids = [ primPackageId,
+ integerPackageId,
+ basePackageId,
+ rtsPackageId,
+ haskell98PackageId,
+ thPackageId,
ndpPackageId ]
wired_in_names = map packageIdString wired_in_pkgids
return (pkgs2, preload1, new_this_pkg)
--- -----------------------------------------------------------------------------
+-- ----------------------------------------------------------------------------
--
--- Eliminate any packages which have dangling dependencies (
--- because the dependency was removed by -ignore-package).
+-- Detect any packages that have missing dependencies, and also any
+-- mutually-recursive groups of packages (loops in the package graph
+-- are not allowed). We do this by taking the least fixpoint of the
+-- dependency graph, repeatedly adding packages whose dependencies are
+-- satisfied until no more can be added.
--
elimDanglingDeps
:: DynFlags
-> [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))
+elimDanglingDeps dflags pkgs ignored = go [] 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
+ -> Either PackageConfig (PackageConfig, [PackageIdentifier])
+ depsAvailable pkgs_ok pkg
+ | null dangling = Left pkg
+ | otherwise = Right (pkg, dangling)
+ where dangling = filter (`notElem` pids) (depends pkg)
+ pids = map package pkgs_ok
+
reportElim (p, deps) =
debugTraceMsg dflags 2 $
(ptext SLIT("package") <+> pprPkg p <+>
- ptext SLIT("will be ignored due to missing dependencies:") $$
+ ptext SLIT("will be ignored due to missing or recursive 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.
pkgs <- elimDanglingDeps dflags pkgs3 ignored
let pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs
- pkgids = map packageConfigId pkgs
-- add base & rts to the preload packages
basicLinkedPackages = filter (flip elemUFM pkg_db)
ps' <- foldM (add_package pkg_db) ps (zip deps (repeat (Just p)))
return (p : ps')
+missingPackageErr :: String -> IO [PackageConfig]
missingPackageErr p = throwDyn (CmdLineError (showSDoc (missingPackageMsg p)))
+
+missingPackageMsg :: String -> SDoc
missingPackageMsg p = ptext SLIT("unknown package:") <+> text p
+missingDependencyMsg :: Maybe PackageId -> SDoc
missingDependencyMsg Nothing = empty
missingDependencyMsg (Just parent)
= space <> parens (ptext SLIT("dependency of") <+> ftext (packageIdFS parent))
projects / ghc-hetmet.git / blobdiff