From f14f1daa67546643b49902c56829d13ec641f21c Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Wed, 22 Dec 2010 17:54:00 +0000 Subject: [PATCH] Implement fuzzy matching for the Finder ..so that you get a more helpful message when you mis-spell a module name in an 'import'. Validates, but not fully tested. Based on Max's patch in Trac #2442, but heavily refactored. --- compiler/main/Finder.lhs | 114 ++++++++++++++++++++++++------------------- compiler/main/HeaderInfo.hs | 3 +- compiler/main/HscTypes.lhs | 24 ++++++--- compiler/main/Packages.lhs | 32 ++++++++++-- 4 files changed, 109 insertions(+), 64 deletions(-) diff --git a/compiler/main/Finder.lhs b/compiler/main/Finder.lhs index 29e1fb6..6b6c52f 100644 --- a/compiler/main/Finder.lhs +++ b/compiler/main/Finder.lhs @@ -131,7 +131,7 @@ findImportedModule hsc_env mod_name mb_pkg = pkg_import = findExposedPackageModule hsc_env mod_name mb_pkg unqual_import = home_import - `orIfNotFound` + `orIfNotFound` findExposedPackageModule hsc_env mod_name Nothing -- | Locate a specific 'Module'. The purpose of this function is to @@ -151,18 +151,21 @@ findExactModule hsc_env mod = -- Helpers orIfNotFound :: IO FindResult -> IO FindResult -> IO FindResult -this `orIfNotFound` or_this = do +orIfNotFound this or_this = do res <- this case res of - NotFound places1 _mb_pkg1 mod_hiddens1 pkg_hiddens1 -> do - res2 <- or_this - case res2 of - NotFound places2 mb_pkg2 mod_hiddens2 pkg_hiddens2 -> - return (NotFound (places1 ++ places2) - mb_pkg2 -- snd arg is the package search - (mod_hiddens1 ++ mod_hiddens2) - (pkg_hiddens1 ++ pkg_hiddens2)) - _other -> return res2 + NotFound { fr_paths = paths1, fr_mods_hidden = mh1 + , fr_pkgs_hidden = ph1, fr_suggestions = s1 } + -> do res2 <- or_this + case res2 of + NotFound { fr_paths = paths2, fr_pkg = mb_pkg2, fr_mods_hidden = mh2 + , fr_pkgs_hidden = ph2, fr_suggestions = s2 } + -> return (NotFound { fr_paths = paths1 ++ paths2 + , fr_pkg = mb_pkg2 -- snd arg is the package search + , fr_mods_hidden = mh1 ++ mh2 + , fr_pkgs_hidden = ph1 ++ ph2 + , fr_suggestions = s1 ++ s2 }) + _other -> return res2 _other -> return res @@ -183,36 +186,38 @@ findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString -> IO FindResult findExposedPackageModule hsc_env mod_name mb_pkg -- not found in any package: - | null found_exposed = return (NotFound [] Nothing mod_hiddens pkg_hiddens) - -- found in just one exposed package: - | [(pkg_conf, _)] <- found_exposed - = let pkgid = packageConfigId pkg_conf in - findPackageModule_ hsc_env (mkModule pkgid mod_name) pkg_conf - | otherwise - = return (FoundMultiple (map (packageConfigId.fst) found_exposed)) - where - dflags = hsc_dflags hsc_env - found = lookupModuleInAllPackages dflags mod_name - - for_this_pkg = filter ((`matches` mb_pkg) . fst) found - - found_exposed = [ (pkg_conf,exposed_mod) - | x@(pkg_conf,exposed_mod) <- for_this_pkg, - is_exposed x ] - - is_exposed (pkg_conf,exposed_mod) = exposed pkg_conf && exposed_mod - - mod_hiddens = [ packageConfigId pkg_conf - | (pkg_conf,False) <- found ] - - pkg_hiddens = [ packageConfigId pkg_conf - | (pkg_conf,_) <- found, not (exposed pkg_conf) ] - - _pkg_conf `matches` Nothing = True - pkg_conf `matches` Just pkg = - case packageName pkg_conf of - PackageName n -> pkg == mkFastString n - + = case lookupModuleWithSuggestions (hsc_dflags hsc_env) mod_name of + Left suggest -> return (NotFound { fr_paths = [], fr_pkg = Nothing + , fr_pkgs_hidden = [], fr_mods_hidden = [] + , fr_suggestions = suggest }) + Right found + | null found_exposed -- Found, but with no exposed copies + -> return (NotFound { fr_paths = [], fr_pkg = Nothing + , fr_pkgs_hidden = mod_hiddens, fr_mods_hidden = pkg_hiddens + , fr_suggestions = [] }) + + | [(pkg_conf,_)] <- found_exposed -- Found uniquely + -> let pkgid = packageConfigId pkg_conf in + findPackageModule_ hsc_env (mkModule pkgid mod_name) pkg_conf + + | otherwise -- Found in more than one place + -> return (FoundMultiple (map (packageConfigId.fst) found_exposed)) + where + for_this_pkg = case mb_pkg of + Nothing -> found + Just p -> filter ((`matches` p) . fst) found + found_exposed = filter is_exposed for_this_pkg + is_exposed (pkg_conf,exposed_mod) = exposed pkg_conf && exposed_mod + + mod_hiddens = [ packageConfigId pkg_conf + | (pkg_conf,False) <- found ] + + pkg_hiddens = [ packageConfigId pkg_conf + | (pkg_conf,_) <- found, not (exposed pkg_conf) ] + + pkg_conf `matches` pkg + = case packageName pkg_conf of + PackageName n -> pkg == mkFastString n modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult modLocationCache hsc_env mod do_this = do @@ -362,8 +367,11 @@ searchPathExts paths mod exts file = base <.> ext ] - search [] = return (NotFound (map fst to_search) (Just (modulePackageId mod)) - [] []) + search [] = return (NotFound { fr_paths = map fst to_search + , fr_pkg = Just (modulePackageId mod) + , fr_mods_hidden = [], fr_pkgs_hidden = [] + , fr_suggestions = [] }) + search ((file, mk_result) : rest) = do b <- doesFileExist file if b @@ -562,22 +570,22 @@ cantFindErr cannot_find _ dflags mod_name find_result -> ptext (sLit "no package matching") <+> quotes (ppr pkg) <+> ptext (sLit "was found") - NotFound files mb_pkg mod_hiddens pkg_hiddens + NotFound { fr_paths = files, fr_pkg = mb_pkg + , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens + , fr_suggestions = suggest } | Just pkg <- mb_pkg, pkg /= thisPackage dflags -> not_found_in_package pkg files | null files && null mod_hiddens && null pkg_hiddens - -> ptext (sLit "it is not a module in the current program, or in any known package.") + -> vcat [ ptext (sLit "it is not a module in the current program, or in any known package.") + , pp_suggestions suggest ] | otherwise -> vcat (map pkg_hidden pkg_hiddens) $$ - vcat (map mod_hidden mod_hiddens) $$ + vcat (map mod_hidden mod_hiddens) $$ tried_these files - NotFoundInPackage pkg - -> ptext (sLit "it is not in package") <+> quotes (ppr pkg) - - _ -> panic "cantFindErr" + _ -> panic "cantFindErr" build_tag = buildTag dflags @@ -619,4 +627,10 @@ cantFindErr cannot_find _ dflags mod_name find_result mod_hidden pkg = ptext (sLit "it is a hidden module in the package") <+> quotes (ppr pkg) + + pp_suggestions sugs + | null sugs = empty + | otherwise = ptext (sLit "Perhaps you meant") <+> vcat (map pp sugs) + where + pp mod = ppr mod <+> parens (ptext (sLit "package") <+> ppr (modulePackageId mod)) \end{code} diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index 4e455a6..24a216a 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -284,7 +284,8 @@ unsupportedExtnError loc unsup = mkPlainErrMsg loc $ text "Unsupported extension: " <> text unsup $$ if null suggestions then empty else text "Perhaps you meant" <+> quotedListWithOr (map text suggestions) - where suggestions = fuzzyMatch unsup supportedLanguagesAndExtensions + where + suggestions = fuzzyMatch unsup supportedLanguagesAndExtensions optionsErrorMsgs :: [String] -> [Located String] -> FilePath -> Messages diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index 8a17a40..bb874bc 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -547,14 +547,22 @@ data FindResult -- ^ The requested package was not found | FoundMultiple [PackageId] -- ^ _Error_: both in multiple packages - | NotFound [FilePath] (Maybe PackageId) [PackageId] [PackageId] - -- ^ The module was not found, including either - -- * the specified places were searched - -- * the package that this module should have been in - -- * list of packages in which the module was hidden, - -- * list of hidden packages containing this module - | NotFoundInPackage PackageId - -- ^ The module was not found in this package + + | NotFound -- Not found + { fr_paths :: [FilePath] -- Places where I looked + + , fr_pkg :: Maybe PackageId -- Just p => module is in this package's + -- manifest, but couldn't find + -- the .hi file + + , fr_mods_hidden :: [PackageId] -- Module is in these packages, + -- but the *module* is hidden + + , fr_pkgs_hidden :: [PackageId] -- Module is in these packages, + -- but the *package* is hidden + + , fr_suggestions :: [Module] -- Possible mis-spelled modules + } -- | Cache that remembers where we found a particular module. Contains both -- home modules and package modules. On @:load@, only home modules are diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 38e5996..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, @@ -879,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 -- 1.7.10.4