X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FPackages.lhs;h=a7c01aef6adcfd5a6f79cd5278484d28021c48bd;hb=c245355e6f2c7b7c95e9af910c4d420e13af9413;hp=bd421bd799cc726ff1fa868b5cfc332135691e48;hpb=fcf6b22d0478be20e27c2245f3e34dd272e12522;p=ghc-hetmet.git diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index bd421bd..a7c01ae 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, @@ -26,7 +19,6 @@ module Packages ( -- * Inspecting the set of packages in scope getPackageIncludePath, - getPackageCIncludes, getPackageLibraryPath, getPackageLinkOpts, getPackageExtraCcOpts, @@ -289,6 +281,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) @@ -302,7 +295,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. @@ -327,11 +320,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 -- ----------------------------------------------------------------------------- @@ -536,7 +532,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) @@ -597,11 +592,6 @@ getPackageIncludePath dflags pkgs = do ps <- getPreloadPackagesAnd dflags pkgs return (nub (filter notNull (concatMap includeDirs ps))) - -- includes are in reverse dependency order (i.e. rts first) -getPackageCIncludes :: [PackageConfig] -> IO [String] -getPackageCIncludes pkg_configs = do - return (reverse (nub (filter notNull (concatMap includes pkg_configs)))) - getPackageLibraryPath :: DynFlags -> [PackageId] -> IO [String] getPackageLibraryPath dflags pkgs = do ps <- getPreloadPackagesAnd dflags pkgs @@ -695,9 +685,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 -> 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))