purescript · csicar · Aug 16, 2019 · Aug 18, 2019 · Aug 20, 2019 · Aug 20, 2019
diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs
@@ -85,7 +85,8 @@ data SimpleErrorMessage
   | OrphanTypeDeclaration Ident
   | RedefinedIdent Ident
   | OverlappingNamesInLet
-  | UnknownName (Qualified Name)
+  | UnknownName [(ModuleName, DeclarationRef)] (Qualified Name)
+  -- ^ possible imports (filled with values in Make); missing name
   | UnknownImport ModuleName Name
   | UnknownImportDataConstructor ModuleName (ProperName 'TypeName) (ProperName 'ConstructorName)
   | UnknownExport Name

diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs
@@ -319,11 +319,11 @@ errorDocUri e = "https://github.com/purescript/documentation/blob/master/errors/
 -- TODO Other possible suggestions:
 -- WildcardInferredType - source span not small enough
 -- DuplicateSelectiveImport - would require 2 ranges to remove and 1 insert
-errorSuggestion :: SimpleErrorMessage -> Maybe ErrorSuggestion
-errorSuggestion err =
+errorSuggestions :: SimpleErrorMessage -> [ErrorSuggestion]
+errorSuggestions err =
     case err of
-      UnusedImport{} -> emptySuggestion
-      DuplicateImport{} -> emptySuggestion
+      UnusedImport{} -> []
+      DuplicateImport{} -> []
       UnusedExplicitImport mn _ qual refs -> suggest $ importSuggestion mn refs qual
       UnusedDctorImport mn _ qual refs -> suggest $ importSuggestion mn refs qual
       UnusedDctorExplicitImport mn _ _ qual refs -> suggest $ importSuggestion mn refs qual
@@ -333,17 +333,21 @@ errorSuggestion err =
       HidingImport mn refs -> suggest $ importSuggestion mn refs Nothing
       MissingTypeDeclaration ident ty -> suggest $ showIdent ident <> " :: " <> T.pack (prettyPrintSuggestedType ty)
       WildcardInferredType ty _ -> suggest $ T.pack (prettyPrintSuggestedType ty)
-      _ -> Nothing
+      UnknownName alternatives _ -> suggestMultiple $ (\(mn, ref) -> importSuggestionWithReexport mn ref) <$> alternatives
+      _ -> []
+  where
+    suggest a = [ErrorSuggestion a]
+    suggestMultiple = map ErrorSuggestion
+    importSuggestionWithReexport :: ModuleName -> DeclarationRef -> Text
+    importSuggestionWithReexport mn (ReExportRef _ _ ref) = importSuggestionWithReexport mn ref
+    importSuggestionWithReexport mn other = importSuggestion mn [other] Nothing
+
+importSuggestion :: ModuleName -> [ DeclarationRef ] -> Maybe ModuleName -> Text
+importSuggestion mn refs qual =
+    "import " <> runModuleName mn <> " (" <> T.intercalate ", " (mapMaybe prettyPrintRef refs) <> ")" <> qstr qual
   where
-    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
-
     qstr :: Maybe ModuleName -> Text
-    qstr (Just mn) = " as " <> runModuleName mn
+    qstr (Just moduleName) = " as " <> runModuleName moduleName
     qstr Nothing = ""
 
 suggestionSpan :: ErrorMessage -> Maybe SourceSpan
@@ -360,10 +364,8 @@ suggestionSpan e =
         MissingTypeDeclaration{} -> startOnly ss
         _ -> ss
 
-showSuggestion :: SimpleErrorMessage -> Text
-showSuggestion suggestion = case errorSuggestion suggestion of
-  Just (ErrorSuggestion x) -> x
-  _ -> ""
+showSuggestions :: SimpleErrorMessage -> [Text]
+showSuggestions simpleError = (\(ErrorSuggestion message) -> message) <$> errorSuggestions simpleError
 
 ansiColor :: (ANSI.ColorIntensity, ANSI.Color) -> String
 ansiColor (intesity, color) =
@@ -534,10 +536,12 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath) e = fl
       line $ "The type declaration for " <> markCode (showIdent nm) <> " should be followed by its definition."
     renderSimpleErrorMessage (RedefinedIdent name) =
       line $ "The value " <> markCode (showIdent name) <> " has been defined multiple times"
-    renderSimpleErrorMessage (UnknownName name@(Qualified Nothing (IdentName (Ident i)))) | i `elem` [ C.bind, C.discard ] =
+    renderSimpleErrorMessage (UnknownName _ name@(Qualified Nothing (IdentName (Ident i)))) | i `elem` [ C.bind, C.discard ] =
       line $ "Unknown " <> printName name <> ". You're probably using do-notation, which the compiler replaces with calls to the " <> markCode i <> " function. Please import " <> markCode i <> " from module " <> markCode "Prelude"
-    renderSimpleErrorMessage (UnknownName name) =
-      line $ "Unknown " <> printName name
+    renderSimpleErrorMessage msg@(UnknownName _ name) =
+      paras [ line $ "Unknown " <> printName name
+            , indent $ Box.vcat Box.left $ line . markCode <$> showSuggestions msg
+            ]
     renderSimpleErrorMessage (UnknownImport mn name) =
       paras [ line $ "Cannot import " <> printName (Qualified Nothing name) <> " from module " <> markCode (runModuleName mn)
             , line "It either does not exist or the module does not export it."
@@ -904,20 +908,20 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath) e = fl
       paras [ line $ "The import of module " <> markCode (runModuleName mn) <> " contains the following unused references:"
             , indent $ paras $ map (line . markCode . runName . Qualified Nothing) names
             , line "It could be replaced with:"
-            , indent $ line $ markCode $ showSuggestion msg ]
+            , indent $ Box.vcat Box.left $ line . markCode <$> showSuggestions msg ]
 
     renderSimpleErrorMessage msg@(UnusedDctorImport mn name _ _) =
       paras [line $ "The import of type " <> markCode (runProperName name)
                     <> " from module " <> markCode (runModuleName mn) <> " includes data constructors but only the type is used"
             , line "It could be replaced with:"
-            , indent $ line $ markCode $ showSuggestion msg ]
+            , indent $ Box.vcat Box.left $ line . markCode <$> showSuggestions msg ]
 
     renderSimpleErrorMessage msg@(UnusedDctorExplicitImport mn name names _ _) =
       paras [ line $ "The import of type " <> markCode (runProperName name)
                      <> " from module " <> markCode (runModuleName mn) <> " includes the following unused data constructors:"
             , indent $ paras $ map (line . markCode . runProperName) names
             , line "It could be replaced with:"
-            , indent $ line $ markCode $ showSuggestion msg ]
+            , indent $ Box.vcat Box.left $ line . markCode <$> showSuggestions msg ]
 
     renderSimpleErrorMessage (DuplicateSelectiveImport name) =
       line $ "There is an existing import of " <> markCode (runModuleName name) <> ", consider merging the import lists"
@@ -938,22 +942,22 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath) e = fl
     renderSimpleErrorMessage msg@(ImplicitQualifiedImport importedModule asModule _) =
       paras [ line $ "Module " <> markCode (runModuleName importedModule) <> " was imported as " <> markCode (runModuleName asModule) <> " with unspecified imports."
             , line $ "As there are multiple modules being imported as " <> markCode (runModuleName asModule) <> ", consider using the explicit form:"
-            , indent $ line $ markCode $ showSuggestion msg
+            , indent $ Box.vcat Box.left $ line . markCode <$> showSuggestions msg
             ]
     renderSimpleErrorMessage msg@(ImplicitQualifiedImportReExport importedModule asModule _) =
       paras [ line $ "Module " <> markCode (runModuleName importedModule) <> " was imported as " <> markCode (runModuleName asModule) <> " with unspecified imports."
             , line $ "As this module is being re-exported, consider using the explicit form:"
-            , indent $ line $ markCode $ showSuggestion msg
+            , indent $ Box.vcat Box.left $ line . markCode <$> showSuggestions msg
             ]
 
     renderSimpleErrorMessage msg@(ImplicitImport mn _) =
       paras [ line $ "Module " <> markCode (runModuleName mn) <> " has unspecified imports, consider using the explicit form: "
-            , indent $ line $ markCode $ showSuggestion msg
+            , indent $ Box.vcat Box.left $ line . markCode <$> showSuggestions msg
             ]
 
     renderSimpleErrorMessage msg@(HidingImport mn _) =
       paras [ line $ "Module " <> markCode (runModuleName mn) <> " has unspecified imports, consider using the inclusive form: "
-            , indent $ line $ markCode $ showSuggestion msg
+            , indent $ Box.vcat Box.left $ line . markCode <$> showSuggestions msg
             ]
 
     renderSimpleErrorMessage (CaseBinderLengthDiffers l bs) =
@@ -1185,6 +1189,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath) e = fl
       paras [ line $ "at " <> displaySourceSpan relPath (NEL.head srcSpan)
             , detail
             ]
+
 
     printRow :: (Int -> Type a -> Box.Box) -> Type a -> Box.Box
     printRow f t = markCodeBox $ indent $ f prettyDepth t

diff --git a/src/Language/PureScript/Errors/JSON.hs b/src/Language/PureScript/Errors/JSON.hs
@@ -69,9 +69,9 @@ toJSONError verbose level e =
                   (P.sourcePosColumn (P.spanEnd   ss))
   toSuggestion :: P.ErrorMessage -> Maybe ErrorSuggestion
   toSuggestion em =
-    case P.errorSuggestion $ P.unwrapErrorMessage em of
-      Nothing -> Nothing
-      Just s -> Just $ ErrorSuggestion (suggestionText s) (toErrorPosition <$> P.suggestionSpan em)
+    case P.errorSuggestions $ P.unwrapErrorMessage em of
+      [] -> Nothing
+      s -> Just $ ErrorSuggestion (T.unlines $ suggestionText <$> s) (toErrorPosition <$> P.suggestionSpan em)
 
   -- TODO: Adding a newline because source spans chomp everything up to the next character
   suggestionText (P.ErrorSuggestion s) = if T.null s then s else s <> "\n"
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/Sugar/Names.hs b/src/Language/PureScript/Sugar/Names.hs
@@ -419,11 +419,11 @@ renameInModule imports (Module modSS coms mn decls exps) =
       (Nothing, Just mn'') ->
         if mn'' `S.member` importedQualModules imports || mn'' `S.member` importedModules imports
         then throwUnknown
-        else throwError . errorMessage . UnknownName . Qualified Nothing $ ModName mn''
+        else throwError . errorMessage . UnknownName [] . Qualified Nothing $ ModName mn''
 
       -- If neither of the above cases are true then it's an undefined or
       -- unimported symbol.
       _ -> throwUnknown
 
     where
-    throwUnknown = throwError . errorMessage . UnknownName . fmap toName $ qname
+    throwUnknown = throwError . errorMessage . UnknownName [] . fmap toName $ qname
diff --git a/src/Language/PureScript/Sugar/Names/Env.hs b/src/Language/PureScript/Sugar/Names/Env.hs
@@ -485,7 +485,7 @@ throwExportConflict' ss new existing newName existingName =
 getExports :: MonadError MultipleErrors m => Env -> ModuleName -> m Exports
 getExports env mn =
   maybe
-    (throwError . errorMessage . UnknownName . Qualified Nothing $ ModName mn)
+    (throwError . errorMessage . UnknownName [] . Qualified Nothing $ ModName mn)
     (return . envModuleExports)
   $ M.lookup mn env
 

diff --git a/src/Language/PureScript/Sugar/Names/Imports.hs b/src/Language/PureScript/Sugar/Names/Imports.hs
@@ -70,7 +70,7 @@ resolveModuleImport env ie (mn, imps) = foldM go ie imps
   go ie' (ss, typ, impQual) = do
     modExports <-
       maybe
-        (throwError . errorMessage' ss . UnknownName . Qualified Nothing $ ModName mn)
+        (throwError . errorMessage' ss . UnknownName [] . Qualified Nothing $ ModName mn)
         (return . envModuleExports)
         (mn `M.lookup` env)
     let impModules = importedModules ie'

diff --git a/src/Language/PureScript/Sugar/Operators.hs b/src/Language/PureScript/Sugar/Operators.hs
@@ -149,7 +149,7 @@ rebracketFiltered pred_ externs modules = do
         Just (Qualified mn' (Right alias)) ->
           return $ Constructor pos (Qualified mn' alias)
         Nothing ->
-          throwError . errorMessage' pos . UnknownName $ fmap ValOpName op
+          throwError . errorMessage' pos . UnknownName [] $ fmap ValOpName op
     goExpr pos other = return (pos, other)
 
     goBinder :: SourceSpan -> Binder -> m (SourceSpan, Binder)
@@ -161,7 +161,7 @@ rebracketFiltered pred_ externs modules = do
         Just (Qualified mn' (Right alias)) ->
           return (pos, ConstructorBinder pos (Qualified mn' alias) [lhs, rhs])
         Nothing ->
-          throwError . errorMessage' pos . UnknownName $ fmap ValOpName op
+          throwError . errorMessage' pos . UnknownName [] $ fmap ValOpName op
     goBinder _ BinaryNoParensBinder{} =
       internalError "BinaryNoParensBinder has no OpBinder"
     goBinder pos other = return (pos, other)
@@ -172,7 +172,7 @@ rebracketFiltered pred_ externs modules = do
         Just alias ->
           return $ TypeApp ann (TypeApp ann (TypeConstructor ann2 alias) lhs) rhs
         Nothing ->
-          throwError . errorMessage' pos $ UnknownName $ fmap TyOpName op
+          throwError . errorMessage' pos $ UnknownName [] $ fmap TyOpName op
     goType _ other = return other
 
 rebracketModule

diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs
@@ -303,7 +303,7 @@ typeInstanceDictionaryDeclaration sa@(ss, _) name mn deps className tys decls =
 
   -- Lookup the type arguments and member types for the type class
   TypeClassData{..} <-
-    maybe (throwError . errorMessage' ss . UnknownName $ fmap TyClassName className) return $
+    maybe (throwError . errorMessage' ss . UnknownName [] $ fmap TyClassName className) return $
       M.lookup (qualify mn className) m
 
   -- Replace the type arguments with the appropriate types in the member types

diff --git a/src/Language/PureScript/Suggest.hs b/src/Language/PureScript/Suggest.hs
@@ -0,0 +1,36 @@
+-- |
+-- This module implements a simple linting pass on the PureScript AST.
+--
+module Language.PureScript.Suggest where
+
+import Prelude.Compat
+
+import Data.Maybe (catMaybes)
+
+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) = ErrorMessage hints (suggestionForSimpleError err)
+
+      suggestionForSimpleError ::  SimpleErrorMessage -> SimpleErrorMessage
+      suggestionForSimpleError (UnknownName imports qualName@(Qualified Nothing name)) = UnknownName (imports ++ findImportForName name) qualName
+      suggestionForSimpleError others = others
+
+      findImportForName :: Name -> [(ModuleName, DeclarationRef)]
+      findImportForName name = 
+        filter ((==name) . declRefName . snd)
+        $ concat
+        $ (\extern -> (\decl -> (efModuleName extern, decl)) <$> efExports extern) <$> compiledExterns
diff --git a/src/Language/PureScript/TypeChecker/Kinds.hs b/src/Language/PureScript/TypeChecker/Kinds.hs
@@ -251,7 +251,7 @@ infer' other = (, []) <$> go other
   go (TypeConstructor ann v) = do
     env <- getEnv
     case M.lookup v (types env) of
-      Nothing -> throwError . errorMessage' (fst ann) . UnknownName $ fmap TyName v
+      Nothing -> throwError . errorMessage' (fst ann) . UnknownName [] $ fmap TyName v
       Just (kind, _) -> return $ kind $> ann
   go (TypeApp ann t1 t2) = do
     k0 <- freshKind ann

diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs
@@ -387,7 +387,7 @@ infer' (Var ss var) = do
 infer' v@(Constructor _ c) = do
   env <- getEnv
   case M.lookup c (dataConstructors env) of
-    Nothing -> throwError . errorMessage . UnknownName . fmap DctorName $ c
+    Nothing -> throwError . errorMessage . UnknownName [] . fmap DctorName $ c
     Just (_, _, ty, _) -> do (v', ty') <- sndM (introduceSkolemScope <=< replaceAllTypeSynonyms) <=< instantiatePolyTypeWithUnknowns v $ ty
                              return $ TypedValue' True v' ty'
 infer' (Case vals binders) = do
@@ -495,7 +495,7 @@ inferBinder val (ConstructorBinder ss ctor binders) = do
       unless (expected == actual) . throwError . errorMessage' ss $ IncorrectConstructorArity ctor expected actual
       unifyTypes ret val
       M.unions <$> zipWithM inferBinder (reverse args) binders
-    _ -> throwError . errorMessage' ss . UnknownName . fmap DctorName $ ctor
+    _ -> throwError . errorMessage' ss . UnknownName [] . fmap DctorName $ ctor
   where
   peelArgs :: Type a -> ([Type a], Type a)
   peelArgs = go []
@@ -731,7 +731,7 @@ check' (Accessor prop val) ty = withErrorMessageHint (ErrorCheckingAccessor val
 check' v@(Constructor _ c) ty = do
   env <- getEnv
   case M.lookup c (dataConstructors env) of
-    Nothing -> throwError . errorMessage . UnknownName . fmap DctorName $ c
+    Nothing -> throwError . errorMessage . UnknownName [] . fmap DctorName $ c
     Just (_, _, ty1, _) -> do
       repl <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty1
       ty' <- introduceSkolemScope ty