Implement fuzzy matching for the Finder
authorsimonpj@microsoft.com <unknown>
Wed, 22 Dec 2010 17:54:00 +0000 (17:54 +0000)
committersimonpj@microsoft.com <unknown>
Wed, 22 Dec 2010 17:54:00 +0000 (17:54 +0000)
..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
compiler/main/HeaderInfo.hs
compiler/main/HscTypes.lhs
compiler/main/Packages.lhs

index 29e1fb6..6b6c52f 100644 (file)
@@ -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}
index 4e455a6..24a216a 100644 (file)
@@ -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
index 8a17a40..bb874bc 100644 (file)
@@ -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
index 38e5996..c4025b8 100644 (file)
@@ -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