X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FPackages.lhs;h=d10d873ed47893f6d5db7b203db28d5b5d98cc1c;hb=f5fbb8242af1b85b763d5be84364e9453e90d7c5;hp=ad841b258e4eaa14340147beabd7e4292926d862;hpb=a4cb9b55d85b08480fd1d149db1aa4a9d46dcb40;p=ghc-hetmet.git diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index ad841b2..d10d873 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -4,13 +4,6 @@ % 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, @@ -53,10 +46,7 @@ import Util import Maybes ( expectJust, MaybeErr(..) ) import Panic import Outputable - -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 603 -import Compat.Directory ( getAppUserDataDirectory ) -#endif +import Pretty ( Doc ) import System.Environment ( getEnv ) import Distribution.InstalledPackageInfo @@ -264,7 +254,10 @@ mungePackagePaths top_dir ps = map munge_pkg ps 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 @@ -290,6 +283,7 @@ applyPackageFlag pkgs flag = 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) @@ -303,7 +297,7 @@ applyPackageFlag pkgs flag = 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. @@ -328,11 +322,14 @@ matchingPackages str pkgs = 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 -- ----------------------------------------------------------------------------- @@ -381,10 +378,12 @@ findWiredInPackages dflags pkgs preload this_package = do -- 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 @@ -535,7 +534,6 @@ mkPackageState dflags orig_pkg_db preload0 this_package = do 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) @@ -694,9 +692,13 @@ add_package pkg_db ps (p, mb_parent) 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 -> PprStyle -> Doc missingPackageMsg p = ptext SLIT("unknown package:") <+> text p +missingDependencyMsg :: Maybe PackageId -> PprStyle -> Doc missingDependencyMsg Nothing = empty missingDependencyMsg (Just parent) = space <> parens (ptext SLIT("dependency of") <+> ftext (packageIdFS parent))