Suggest import for name causing a UnknownName error

purescript · csicar · Aug 16, 2019 · Aug 18, 2019 · Aug 20, 2019 · Aug 20, 2019
commit bb5aa2c854b0d8ae6629276c448ddfdbbf097726
diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs
@@ -205,6 +205,7 @@ data ErrorMessageHint
   | ErrorInTypeClassDeclaration (ProperName 'ClassName)
   | ErrorInForeignImport Ident
   | ErrorSolvingConstraint SourceConstraint
+  | ErrorMissingImport (NEL.NonEmpty (ModuleName, DeclarationRef)) -- List of possible import matching the expected name
   | PositionedError (NEL.NonEmpty SourceSpan)
   deriving (Show)
 

diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs
@@ -338,12 +338,12 @@ errorSuggestion err =
     emptySuggestion = Just $ ErrorSuggestion ""
     suggest = Just . ErrorSuggestion
 
-    importSuggestion :: ModuleName -> [ DeclarationRef ] -> Maybe ModuleName -> Text
-    importSuggestion mn refs qual =
-      "import " <> runModuleName mn <> " (" <> T.intercalate ", " (mapMaybe prettyPrintRef refs) <> ")" <> qstr qual
-
+importSuggestion :: ModuleName -> [ DeclarationRef ] -> Maybe ModuleName -> Text
+importSuggestion mn refs qual =
+    "import " <> runModuleName mn <> " (" <> T.intercalate ", " (mapMaybe prettyPrintRef refs) <> ")" <> qstr qual
+  where
     qstr :: Maybe ModuleName -> Text
-    qstr (Just mn) = " as " <> runModuleName mn
+    qstr (Just moduleName) = " as " <> runModuleName moduleName
     qstr Nothing = ""
 
 suggestionSpan :: ErrorMessage -> Maybe SourceSpan
@@ -1185,6 +1185,17 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath) e = fl
       paras [ line $ "at " <> displaySourceSpan relPath (NEL.head srcSpan)
             , detail
             ]
+    renderHint (ErrorMissingImport importOptions) detail =
+      paras [ detail
+            , line $ "Perhaps you want to add it to the import list? " <> message
+            , markCodeBox $ indent $ Box.vcat Box.left $ (line . renderImport) <$> importOptions
+            ]
+      where
+        renderImport (mn, (ReExportRef _ _ ref)) = importSuggestion mn [ref] Nothing
+        renderImport (mn, ref) = importSuggestion mn [ref] Nothing
+        message = case length importOptions of
+          1 -> "1 possible import was found:"
+          n -> T.pack (show n) <> " possible imports were found:"
 
     printRow :: (Int -> Type a -> Box.Box) -> Type a -> Box.Box
     printRow f t = markCodeBox $ indent $ f prettyDepth t

diff --git a/src/Language/PureScript/Make.hs b/src/Language/PureScript/Make.hs
@@ -34,6 +34,7 @@ import           Language.PureScript.Environment
 import           Language.PureScript.Errors
 import           Language.PureScript.Externs
 import           Language.PureScript.Linter
+import           Language.PureScript.Suggest
 import           Language.PureScript.ModuleDependencies
 import           Language.PureScript.Names
 import           Language.PureScript.Renamer
@@ -125,7 +126,8 @@ make ma@MakeActions{..} ms = do
   results <- BuildPlan.collectResults buildPlan
 
   -- All threads have completed, rethrow any caught errors.
-  let errors = mapMaybe buildJobFailure $ M.elems results
+  let errors = decorateSuggestions (M.elems results) $ mapMaybe buildJobFailure $ M.elems results
+
   unless (null errors) $ throwError (mconcat errors)
 
   -- Here we return all the ExternsFile in the ordering of the topological sort,

diff --git a/src/Language/PureScript/Suggest.hs b/src/Language/PureScript/Suggest.hs
@@ -0,0 +1,39 @@
+-- |
+-- This module implements a simple linting pass on the PureScript AST.
+--
+module Language.PureScript.Suggest where
+
+import Prelude.Compat
+
+import Data.Maybe (catMaybes, maybeToList)
+
+import qualified Data.List.NonEmpty as NEL
+
+import Language.PureScript.Make.BuildPlan
+import           Language.PureScript.Errors
+import           Language.PureScript.Externs
+import Language.PureScript.Names
+
+
+decorateSuggestions :: [BuildJobResult] -> [MultipleErrors] -> [MultipleErrors]
+decorateSuggestions jobs multipleErrors = decorateMultipleErrors <$> multipleErrors
+    where
+      compiledExterns :: [ExternsFile]
+      compiledExterns = snd <$> (catMaybes $ buildJobSuccess <$> jobs)
+
+      decorateMultipleErrors :: MultipleErrors -> MultipleErrors
+      decorateMultipleErrors (MultipleErrors errs) = MultipleErrors $ decorateErrorMessage <$> errs
+
+      decorateErrorMessage :: ErrorMessage -> ErrorMessage
+      decorateErrorMessage (ErrorMessage hints err@(UnknownName (Qualified Nothing name))) = ErrorMessage (hints ++ maybeToList (importHintsForModule name)) err
+      decorateErrorMessage others = others
+
+      importHintsForModule :: Name -> Maybe ErrorMessageHint
+      importHintsForModule name = ErrorMissingImport <$> NEL.nonEmpty qualifiedValues 
+        where qualifiedValues = findImportForName name 
+
+      findImportForName :: Name -> [(ModuleName, DeclarationRef)]
+      findImportForName name = 
+        filter ((==name) . declRefName . snd)
+        $ concat
+        $ (\extern -> (\decl -> (efModuleName extern, decl)) <$> efExports extern) <$> compiledExterns