5bea92f · ghcide · git.iko.soy

git.iko.soy/ghcide

Code action to suggest adding missing imports from pkg db (#437)

* Code action to suggest adding missing imports from pkg db The implementation looks in modules loaded from the package database. It should only look in packages declared as dependencies of the project. The package modules are loaded lazily and are global to the HscEnv, so the success rate will depend on what has been loaded so far in the env. * Avoid overlapping with extend import suggestions > import Data.Text (Text) > foo = pack "foo" Teach ghcide to suggest only: "Add pack to the import list of Data.Text" and avoid suggesting also: "Import Data.Text (pack)"

commit5bea92f9d3f835098b9aea4109165611e9186eef authorPepe Iborra <pepeiborra@gmail.com> dateTue 18 Feb 2020, 08:36 (7 years ago) parentf586955

2 files changed+82−4

compare with master

unifiedsplit

src/Development/IDE/Plugin/CodeAction.hs+48−3 test/exe/Main.hs+34−1

src/Development/IDE/Plugin/CodeAction.hs+48−3

@@ -8,6 +8,7 @@

88-- | Go to the definition of a variable.

99module Development.IDE.Plugin.CodeAction(plugin) where

1010

11+import Avail (availNames)

1112import Language.Haskell.LSP.Types

1213import Control.Monad (join)

1314import Development.IDE.Plugin

@@ -43,6 +44,9 @@ import Text.Regex.TDFA.Text()

4344import Outputable (showSDoc, ppr, showSDocUnsafe)

4445import DynFlags (xFlags, FlagSpec(..))

4546import GHC.LanguageExtensions.Type (Extension)

47+import Data.Function (on)

48+import Data.IORef (readIORef)

49+import Name (nameModule_maybe, nameOccName)

4650

4751plugin :: Plugin c

4852plugin = codeActionPlugin codeAction <> Plugin mempty setHandlersCodeLens

@@ -66,9 +70,10 @@ codeAction lsp state (TextDocumentIdentifier uri) _range CodeActionContext{_diag

6670 <*> getParsedModule `traverse` mbFile

6771 <*> use_ GhcSession `traverse` mbFile

6872 let dflags = hsc_dflags . hscEnv <$> env

73+ eps <- traverse readIORef (hsc_EPS . hscEnv <$> env)

6974 pure $ Right

7075 [ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List [x]) (Just edit) Nothing

71− | x <- xs, (title, tedit) <- suggestAction dflags ideOptions ( join parsedModule ) text x

76+ | x <- xs, (title, tedit) <- suggestAction dflags eps ideOptions ( join parsedModule ) text x

7277 , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing

7378 ]

7479

@@ -107,8 +112,15 @@ executeAddSignatureCommand _lsp _ideState ExecuteCommandParams{..}

107112 | otherwise

108113 = return (Null, Nothing)

109114

110−suggestAction :: Maybe DynFlags -> IdeOptions -> Maybe ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]

111−suggestAction dflags ideOptions parsedModule text diag = concat

115+suggestAction

116+ :: Maybe DynFlags

117+ -> Maybe ExternalPackageState

118+ -> IdeOptions

119+ -> Maybe ParsedModule

120+ -> Maybe T.Text

121+ -> Diagnostic

122+ -> [(T.Text, [TextEdit])]

123+suggestAction dflags eps ideOptions parsedModule text diag = concat

112124 [ suggestAddExtension diag

113125 , suggestExtendImport dflags text diag

114126 , suggestFillHole diag

@@ -120,6 +132,7 @@ suggestAction dflags ideOptions parsedModule text diag = concat

120132 ] ++ concat

121133 [ suggestNewDefinition ideOptions pm text diag

122134 ++ suggestRemoveRedundantImport pm text diag

135+ ++ concat [suggestNewImport eps pm diag | Just eps <- [eps]]

123136 | Just pm <- [parsedModule]]

124137

125138

@@ -334,6 +347,38 @@ suggestSignature isQuickFix Diagnostic{_range=_range@Range{..},..}

334347

335348suggestSignature _ _ = []

336349

350+suggestNewImport :: ExternalPackageState -> ParsedModule -> Diagnostic -> [(T.Text, [TextEdit])]

351+suggestNewImport eps ParsedModule {pm_parsed_source = L _ HsModule {..}} Diagnostic{_message}

352+ | Just [name] <- matchRegex (unifySpaces _message) "Variable not in scope: ([^ ]+)"

353+ , items <- typeEnvElts $ eps_PTE eps

354+ , Just insertLine <- case hsmodImports of

355+ [] -> case srcSpanStart $ getLoc (head hsmodDecls) of

356+ RealSrcLoc s -> Just $ srcLocLine s - 1

357+ _ -> Nothing

358+ _ -> case srcSpanEnd $ getLoc (last hsmodImports) of

359+ RealSrcLoc s -> Just $ srcLocLine s

360+ _ -> Nothing

361+ , insertPos <- Position insertLine 0

362+ , extendImportSuggestions <- -- Just [binding, mod, srcspan] <-

363+ matchRegex _message

364+ "Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’"

365+ =

366+ nubOrdBy

367+ (compare `on` fst)

368+ [ ( edit,

369+ [TextEdit (Range insertPos insertPos) (edit <> "\n")]

370+ )

371+ | item <- items,

372+ avail <- tyThingAvailInfo item,

373+ candidate <- availNames avail,

374+ occNameString (nameOccName candidate) == T.unpack name,

375+ Just m <- [nameModule_maybe candidate],

376+ let modName = T.pack $ moduleNameString $ moduleName m,

377+ modName `notElem` fromMaybe [] extendImportSuggestions,

378+ let edit = "import " <> modName <> " (" <> T.pack (prettyPrint candidate) <> ")"

379+ ]

380+suggestNewImport _ _ _ = []

381+

337382topOfHoleFitsMarker :: T.Text

338383topOfHoleFitsMarker =

339384#if MIN_GHC_API_VERSION(8,6,0)

test/exe/Main.hs+34−1

@@ -412,6 +412,7 @@ codeActionTests = testGroup "code actions"

412412 , typeWildCardActionTests

413413 , removeImportTests

414414 , extendImportTests

415+ , suggestImportTests

415416 , addExtensionTests

416417 , fixConstructorImportTests

417418 , importRenameActionTests

@@ -895,6 +896,38 @@ extendImportTests = testGroup "extend import actions"

895896 contentAfterAction <- documentContents docB

896897 liftIO $ expectedContentB @=? contentAfterAction

897898

899+suggestImportTests :: TestTree

900+suggestImportTests = testGroup "suggest import actions"

901+ [ testGroup "Dont want suggestion"

902+ [ test False ["Data.List.NonEmpty ()"] "f = nonEmpty" "import Data.List.NonEmpty (nonEmpty)"

903+ ]

904+ , testGroup "want suggestion"

905+ [ test True [] "f = nonEmpty" "import Data.List.NonEmpty (nonEmpty)"

906+ , test True ["Prelude"] "f = nonEmpty" "import Data.List.NonEmpty (nonEmpty)"

907+ ]

908+ ]

909+ where

910+ test wanted imps def newImp = testSession (T.unpack def) $ do

911+ let before = T.unlines $ "module A where" : ["import " <> x | x <- imps] ++ [def]

912+ after = T.unlines $ "module A where" : ["import " <> x | x <- imps] ++ [newImp, def]

913+ doc <- openDoc' "Test.hs" "haskell" before

914+ -- load another module in the session to exercise the package cache

915+ _ <- openDoc' "Other.hs" "haskell" after

916+ _diags <- waitForDiagnostics

917+ liftIO $ print _diags

918+ let defLine = length imps + 1

919+ range = Range (Position defLine 0) (Position defLine maxBound)

920+ actions <- getCodeActions doc range

921+ case wanted of

922+ False ->

923+ liftIO $ [_title | CACodeAction CodeAction{_title} <- actions, _title == newImp ] @?= []

924+ True -> do

925+ liftIO $ print [_title | CACodeAction CodeAction{_title} <- actions]

926+ let action = pickActionWithTitle newImp actions

927+ executeCodeAction action

928+ contentAfterAction <- documentContents doc

929+ liftIO $ after @=? contentAfterAction

930+

898931addExtensionTests :: TestTree

899932addExtensionTests = testGroup "add language extension actions"

900933 [ testSession "add NamedFieldPuns language extension" $ template

@@ -1914,7 +1947,7 @@ findCodeActions doc range expectedTitles = do

19141947 [ actionTitle

19151948 | CACodeAction CodeAction { _title = actionTitle } <- actions

19161949 ]

1917− ++ "is not a superset of "

1950+ ++ " is not a superset of "

19181951 ++ show expectedTitles

19191952 liftIO $ case matches of

19201953 Nothing -> assertFailure msg