X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FPackages.lhs;h=c4025b850c7e64d050eee9ee09329300ae72a9c8;hb=81d7d5586e88caa9798d4c401bd28acc73e4e6e1;hp=b080b95b1af4e5d4302d0ff4f3610d91abc39ce2;hpb=9e6ca39b5e90b7a4acc755e3e95cc3ef60940070;p=ghc-hetmet.git diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index b080b95..c4025b8 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -14,7 +14,7 @@ module Packages ( PackageState(..), initPackages, getPackageDetails, - lookupModuleInAllPackages, + lookupModuleInAllPackages, lookupModuleWithSuggestions, -- * Inspecting the set of packages in scope getPackageIncludePath, @@ -170,7 +170,7 @@ initPackages :: DynFlags -> IO (DynFlags, [PackageId]) 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, @@ -359,6 +359,15 @@ comparing f a b = f a `compare` f b 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 ": ") $$ @@ -419,7 +428,6 @@ findWiredInPackages dflags pkgs = do integerPackageId, basePackageId, rtsPackageId, - haskell98PackageId, thPackageId, dphSeqPackageId, dphParPackageId ] @@ -871,10 +879,32 @@ getPackageFrameworks dflags pkgs = do -- @(pkgconf, exposed)@ where pkgconf is the PackageConfig for that package, -- and exposed is @True@ if the package exposes the module. lookupModuleInAllPackages :: DynFlags -> ModuleName -> [(PackageConfig,Bool)] -lookupModuleInAllPackages dflags m = - case lookupUFM (moduleToPkgConfAll (pkgState dflags)) m of - Nothing -> [] - Just ps -> ps +lookupModuleInAllPackages dflags m + = case lookupModuleWithSuggestions dflags m of + Right pbs -> pbs + Left _ -> [] + +lookupModuleWithSuggestions + :: DynFlags -> ModuleName + -> Either [Module] [(PackageConfig,Bool)] + -- Lookup module in all packages + -- Right pbs => found in pbs + -- Left ms => not found; but here are sugestions +lookupModuleWithSuggestions dflags m + = case lookupUFM (moduleToPkgConfAll pkg_state) m of + Nothing -> Left suggestions + Just ps -> Right ps + where + pkg_state = pkgState dflags + suggestions + | dopt Opt_HelpfulErrors dflags = fuzzyLookup (moduleNameString m) all_mods + | otherwise = [] + + all_mods :: [(String, Module)] -- All modules + all_mods = [ (moduleNameString mod_nm, mkModule pkg_id mod_nm) + | pkg_config <- eltsUFM (pkgIdMap pkg_state) + , let pkg_id = packageConfigId pkg_config + , mod_nm <- exposedModules pkg_config ] -- | Find all the 'PackageConfig' in both the preload packages from 'DynFlags' and corresponding to the list of -- 'PackageConfig's