diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 6a7a636e55..acd76150ed 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -700,17 +700,32 @@ suggestFillTypeWildcard Diagnostic{_range=_range,..} = [("Use type signature: ‘" <> typeSignature <> "’", TextEdit _range typeSignature)] | otherwise = [] +{- Handles two variants with different formatting + +1. Could not find module ‘Data.Cha’ + Perhaps you meant Data.Char (from base-4.12.0.0) + +2. Could not find module ‘Data.I’ + Perhaps you meant + Data.Ix (from base-4.14.3.0) + Data.Eq (from base-4.14.3.0) + Data.Int (from base-4.14.3.0) +-} suggestModuleTypo :: Diagnostic -> [(T.Text, TextEdit)] suggestModuleTypo Diagnostic{_range=_range,..} --- src/Development/IDE/Core/Compile.hs:58:1: error: --- Could not find module ‘Data.Cha’ --- Perhaps you meant Data.Char (from base-4.12.0.0) - | "Could not find module" `T.isInfixOf` _message - , "Perhaps you meant" `T.isInfixOf` _message = let - findSuggestedModules = map (head . T.words) . drop 2 . T.lines - proposeModule mod = ("replace with " <> mod, TextEdit _range mod) - in map proposeModule $ nubOrd $ findSuggestedModules _message + | "Could not find module" `T.isInfixOf` _message = + case T.splitOn "Perhaps you meant" _message of + [_, stuff] -> + [ ("replace with " <> modul, TextEdit _range modul) + | modul <- mapMaybe extractModule (T.lines stuff) + ] + _ -> [] | otherwise = [] + where + extractModule line = case T.words line of + [modul, "(from", _] -> Just modul + _ -> Nothing + suggestFillHole :: Diagnostic -> [(T.Text, TextEdit)] suggestFillHole Diagnostic{_range=_range,..} diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index dfb6e8e026..6a366ebbdd 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -778,6 +778,7 @@ codeActionTests = testGroup "code actions" , suggestHideShadowTests , suggestImportDisambiguationTests , fixConstructorImportTests + , fixModuleImportTypoTests , importRenameActionTests , fillTypedHoleTests , addSigActionTests @@ -1804,6 +1805,31 @@ extendImportTests = testGroup "extend import actions" contentAfterAction <- documentContents docB liftIO $ expectedContentB @=? contentAfterAction +fixModuleImportTypoTests :: TestTree +fixModuleImportTypoTests = testGroup "fix module import typo" + [ testSession "works when single module suggested" $ do + doc <- createDoc "A.hs" "haskell" "import Data.Cha" + _ <- waitForDiagnostics + InR action@CodeAction { _title = actionTitle } : _ <- getCodeActions doc (R 0 0 0 10) + liftIO $ actionTitle @?= "replace with Data.Char" + executeCodeAction action + contentAfterAction <- documentContents doc + liftIO $ contentAfterAction @?= "import Data.Char" + , testSession "works when multiple modules suggested" $ do + doc <- createDoc "A.hs" "haskell" "import Data.I" + _ <- waitForDiagnostics + actions <- sortOn (\(InR CodeAction{_title=x}) -> x) <$> getCodeActions doc (R 0 0 0 10) + let actionTitles = [ title | InR CodeAction{_title=title} <- actions ] + liftIO $ actionTitles @?= [ "replace with Data.Eq" + , "replace with Data.Int" + , "replace with Data.Ix" + ] + let InR replaceWithDataEq : _ = actions + executeCodeAction replaceWithDataEq + contentAfterAction <- documentContents doc + liftIO $ contentAfterAction @?= "import Data.Eq" + ] + extendImportTestsRegEx :: TestTree extendImportTestsRegEx = testGroup "regex parsing" [