Skip to content

Commit acc4a0a

Browse files
pepeiborrapepeiborra
authored
Guess more imports (#451)
Now guess missing imports also works for: - Type names - Data constructors - Operators - qualified things Avoiding: - internal modules
1 parent 6f3bd73 commit acc4a0a

File tree

2 files changed

+125
-44
lines changed

2 files changed

+125
-44
lines changed

‎src/Development/IDE/Plugin/CodeAction.hs

Lines changed: 81 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@
88
-- | Go to the definition of a variable.
99
module Development.IDE.Plugin.CodeAction(plugin) where
1010

11-
import Avail (availNames)
11+
import Avail (AvailInfo(Avail), AvailInfo(AvailTC), availNames)
1212
import Language.Haskell.LSP.Types
1313
import Control.Monad (join)
1414
import Development.IDE.Plugin
@@ -41,12 +41,12 @@ import Parser
4141
import RdrName
4242
import Text.Regex.TDFA ((=~), (=~~))
4343
import Text.Regex.TDFA.Text()
44-
import Outputable (showSDoc, ppr, showSDocUnsafe)
44+
import Outputable (ppr, showSDocUnsafe)
4545
import DynFlags (xFlags, FlagSpec(..))
4646
import GHC.LanguageExtensions.Type (Extension)
47-
import Data.Function (on)
4847
import Data.IORef (readIORef)
49-
import Name (nameModule_maybe, nameOccName)
48+
import Name (isDataConName, nameModule_maybe, nameOccName)
49+
import Packages (exposedModules, lookupPackage)
5050

5151
plugin :: Plugin c
5252
plugin = codeActionPlugin codeAction <> Plugin mempty setHandlersCodeLens
@@ -132,7 +132,7 @@ suggestAction dflags eps ideOptions parsedModule text diag = concat
132132
] ++ concat
133133
[ suggestNewDefinition ideOptions pm text diag
134134
++ suggestRemoveRedundantImport pm text diag
135-
++ concat [suggestNewImport eps pm diag | Just eps <- [eps]]
135+
++ concat [suggestNewImport dflags eps pm diag | Just eps <- [eps], Just dflags <- [dflags]]
136136
| Just pm <- [parsedModule]]
137137

138138

@@ -303,12 +303,16 @@ suggestExtendImport (Just dflags) contents Diagnostic{_range=_range,..}
303303
in x{_end = (_end x){_character = succ (_character (_end x))}}
304304
_ -> error "bug in srcspan parser"
305305
importLine = textInRange range c
306-
printedName = let rn = rdrNameOcc name in showSDoc dflags $ parenSymOcc rn (ppr rn)
307306
in [("Add " <> binding <> " to the import list of " <> mod
308-
, [TextEdit range (addBindingToImportList (T.pack printedName) importLine)])]
307+
, [TextEdit range (addBindingToImportList (printRdrName name) importLine)])]
309308
| otherwise = []
310309
suggestExtendImport Nothing _ _ = []
311310

311+
printRdrName :: RdrName -> T.Text
312+
printRdrName name = T.pack $ showSDocUnsafe $ parenSymOcc rn (ppr rn)
313+
where
314+
rn = rdrNameOcc name
315+
312316
suggestFixConstructorImport :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
313317
suggestFixConstructorImport _ Diagnostic{_range=_range,..}
314318
-- ‘Success’ is a data constructor of ‘Result’
@@ -347,10 +351,12 @@ suggestSignature isQuickFix Diagnostic{_range=_range@Range{..},..}
347351

348352
suggestSignature _ _ = []
349353

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+
-------------------------------------------------------------------------------------------------
355+
356+
suggestNewImport :: DynFlags -> ExternalPackageState -> ParsedModule -> Diagnostic -> [(T.Text, [TextEdit])]
357+
suggestNewImport dflags eps ParsedModule {pm_parsed_source = L _ HsModule {..}} Diagnostic{_message}
358+
| msg <- unifySpaces _message
359+
, Just name <- extractNotInScopeName msg
354360
, Just insertLine <- case hsmodImports of
355361
[] -> case srcSpanStart $ getLoc (head hsmodDecls) of
356362
RealSrcLoc s -> Just $ srcLocLine s - 1
@@ -360,24 +366,77 @@ suggestNewImport eps ParsedModule {pm_parsed_source = L _ HsModule {..}} Diagnos
360366
_ -> Nothing
361367
, insertPos <- Position insertLine 0
362368
, extendImportSuggestions <- -- Just [binding, mod, srcspan] <-
363-
matchRegex _message
369+
matchRegex msg
364370
"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+
= [(imp, [TextEdit (Range insertPos insertPos) (imp <> "\n")])
372+
| imp <- constructNewImportSuggestions dflags eps name extendImportSuggestions
373+
]
374+
suggestNewImport _ _ _ _ = []
375+
376+
constructNewImportSuggestions :: DynFlags -> ExternalPackageState -> NotInScope -> Maybe [T.Text] -> [T.Text]
377+
constructNewImportSuggestions dflags eps thingMissing notTheseModules = nubOrd
378+
[ case qual of
379+
Nothing -> "import " <> modName <> " (" <> importWhat candidate avail <> ")"
380+
Just q -> "import qualified " <> modName <> " as " <> q
371381
| item <- items,
372382
avail <- tyThingAvailInfo item,
383+
canUseAvail thingMissing avail,
373384
candidate <- availNames avail,
385+
canUseName thingMissing candidate,
374386
occNameString (nameOccName candidate) == T.unpack name,
375387
Just m <- [nameModule_maybe candidate],
388+
Just package <- [lookupPackage dflags (moduleUnitId m)],
389+
moduleName m `elem` map fst (exposedModules package),
376390
let modName = T.pack $ moduleNameString $ moduleName m,
377-
modName `notElem` fromMaybe [] extendImportSuggestions,
378-
let edit = "import " <> modName <> " (" <> T.pack (prettyPrint candidate) <> ")"
391+
modName `notElem` fromMaybe [] notTheseModules
379392
]
380-
suggestNewImport _ _ _ = []
393+
where
394+
(qual, name) = case T.splitOn "." (notInScope thingMissing) of
395+
[n] -> (Nothing, n)
396+
segments -> (Just (T.concat $ init segments), last segments)
397+
items = typeEnvElts $ eps_PTE eps
398+
importWhat this (AvailTC parent _ _)
399+
-- "Maybe(Just)"
400+
| this /= parent
401+
= T.pack (occNameString (nameOccName parent)) <>
402+
"(" <> printName this <> ")"
403+
importWhat this _ = printName this
404+
405+
printName = printRdrName . nameRdrName
406+
407+
canUseAvail :: NotInScope -> AvailInfo -> Bool
408+
canUseAvail NotInScopeDataConstructor{} Avail{} = False
409+
canUseAvail _ _ = True
410+
411+
canUseName :: NotInScope -> Name -> Bool
412+
canUseName NotInScopeDataConstructor{} = isDataConName
413+
canUseName _ = const True
414+
415+
data NotInScope
416+
= NotInScopeDataConstructor T.Text
417+
| NotInScopeTypeConstructorOrClass T.Text
418+
| NotInScopeThing T.Text
419+
deriving Show
420+
421+
notInScope :: NotInScope -> T.Text
422+
notInScope (NotInScopeDataConstructor t) = t
423+
notInScope (NotInScopeTypeConstructorOrClass t) = t
424+
notInScope (NotInScopeThing t) = t
425+
426+
extractNotInScopeName :: T.Text -> Maybe NotInScope
427+
extractNotInScopeName x
428+
| Just [name] <- matchRegex x "Data constructor not in scope: ([^ ]+)"
429+
= Just $ NotInScopeDataConstructor name
430+
| Just [name] <- matchRegex x "ot in scope: type constructor or class [^‘]*‘([^’]*)’"
431+
= Just $ NotInScopeTypeConstructorOrClass name
432+
| Just [name] <- matchRegex x "ot in scope: ([^‘ ]+)"
433+
= Just $ NotInScopeThing name
434+
| Just [name] <- matchRegex x "ot in scope:[^‘]*‘([^’]*)’"
435+
= Just $ NotInScopeThing name
436+
| otherwise
437+
= Nothing
438+
439+
-------------------------------------------------------------------------------------------------
381440

382441
topOfHoleFitsMarker :: T.Text
383442
topOfHoleFitsMarker =
@@ -511,4 +570,4 @@ filterNewlines :: T.Text -> T.Text
511570
filterNewlines = T.concat . T.lines
512571

513572
unifySpaces :: T.Text -> T.Text
514-
unifySpaces = T.unwords . T.words
573+
unifySpaces = T.unwords . T.words

‎test/exe/Main.hs

Lines changed: 44 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -899,31 +899,44 @@ extendImportTests = testGroup "extend import actions"
899899
suggestImportTests :: TestTree
900900
suggestImportTests = testGroup "suggest import actions"
901901
[ testGroup "Dont want suggestion"
902-
[ test False ["Data.List.NonEmpty ()"] "f = nonEmpty" "import Data.List.NonEmpty (nonEmpty)"
902+
[ -- extend import
903+
test False ["Data.List.NonEmpty ()"] "f = nonEmpty" [] "import Data.List.NonEmpty (nonEmpty)"
904+
-- data constructor
905+
, test False [] "f = First" [] "import Data.Monoid (First)"
906+
-- internal module
907+
, test False [] "f :: Typeable a => a" ["f = undefined"] "import Data.Typeable.Internal (Typeable)"
903908
]
904909
, testGroup "want suggestion"
905-
[ test True [] "f = nonEmpty" "import Data.List.NonEmpty (nonEmpty)"
906-
, test True ["Prelude"] "f = nonEmpty" "import Data.List.NonEmpty (nonEmpty)"
910+
[ test True [] "f = nonEmpty" [] "import Data.List.NonEmpty (nonEmpty)"
911+
, test True [] "f = (:|)" [] "import GHC.Base (NonEmpty((:|)))"
912+
, test True [] "f :: Natural" ["f = undefined"] "import GHC.Natural (Natural)"
913+
, test True [] "f :: NonEmpty ()" ["f = () :| []"] "import GHC.Base (NonEmpty)"
914+
, test True [] "f = First" [] "import Data.Monoid (First(First))"
915+
, test True ["Prelude"] "f = nonEmpty" [] "import Data.List.NonEmpty (nonEmpty)"
916+
, test True [] "f :: Alternative f => f ()" ["f = undefined"] "import GHC.Base (Alternative)"
917+
, test True [] "f = empty" [] "import GHC.Base (Alternative(empty))"
918+
, test True [] "f = (&)" [] "import Data.Function ((&))"
919+
, test True [] "f = NE.nonEmpty" [] "import qualified Data.List.NonEmpty as NE"
920+
, expectFailBecause "known broken - reexported name" $
921+
test True [] "f :: Typeable a => a" ["f = undefined"] "import Data.Typeable (Typeable)"
907922
]
908923
]
909924
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]
925+
test wanted imps def other newImp = testSession (T.unpack def) $ do
926+
let before = T.unlines $ "module A where" : ["import " <> x | x <- imps] ++ def : other
927+
after = T.unlines $ "module A where" : ["import " <> x | x <- imps] ++ [newImp] ++ def : other
913928
doc <- openDoc' "Test.hs" "haskell" before
914929
-- load another module in the session to exercise the package cache
915930
_ <- openDoc' "Other.hs" "haskell" after
916931
_diags <- waitForDiagnostics
917-
liftIO $ print _diags
918932
let defLine = length imps + 1
919933
range = Range (Position defLine 0) (Position defLine maxBound)
920934
actions <- getCodeActions doc range
921935
case wanted of
922936
False ->
923937
liftIO $ [_title | CACodeAction CodeAction{_title} <- actions, _title == newImp ] @?= []
924938
True -> do
925-
liftIO $ print [_title | CACodeAction CodeAction{_title} <- actions]
926-
let action = pickActionWithTitle newImp actions
939+
action <- liftIO $ pickActionWithTitle newImp actions
927940
executeCodeAction action
928941
contentAfterAction <- documentContents doc
929942
liftIO $ after @=? contentAfterAction
@@ -1119,7 +1132,7 @@ fillTypedHoleTests = let
11191132
doc <- openDoc' "Testing.hs" "haskell" originalCode
11201133
_ <- waitForDiagnostics
11211134
actionsOrCommands <- getCodeActions doc (Range (Position 9 0) (Position 9 maxBound))
1122-
let chosenAction = pickActionWithTitle actionTitle actionsOrCommands
1135+
chosenAction <- liftIO $ pickActionWithTitle actionTitle actionsOrCommands
11231136
executeCodeAction chosenAction
11241137
modifiedCode <- documentContents doc
11251138
liftIO $ expectedCode @=? modifiedCode
@@ -1167,7 +1180,7 @@ addSigActionTests = let
11671180
doc <- openDoc' "Sigs.hs" "haskell" originalCode
11681181
_ <- waitForDiagnostics
11691182
actionsOrCommands <- getCodeActions doc (Range (Position 3 1) (Position 3 maxBound))
1170-
let chosenAction = pickActionWithTitle ("add signature: " <> sig) actionsOrCommands
1183+
chosenAction <- liftIO $ pickActionWithTitle ("add signature: " <> sig) actionsOrCommands
11711184
executeCodeAction chosenAction
11721185
modifiedCode <- documentContents doc
11731186
liftIO $ expectedCode @=? modifiedCode
@@ -1717,22 +1730,22 @@ outlineTests = testGroup
17171730
docId <- openDoc' "A.hs" "haskell" source
17181731
symbols <- getDocumentSymbols docId
17191732
liftIO $ symbols @?= Left
1720-
[docSymbolWithChildren "imports"
1721-
SkModule
1733+
[docSymbolWithChildren "imports"
1734+
SkModule
17221735
(R 0 0 0 17)
1723-
[ docSymbol "import Data.Maybe" SkModule (R 0 0 0 17)
1736+
[ docSymbol "import Data.Maybe" SkModule (R 0 0 0 17)
17241737
]
17251738
]
17261739
, testSessionWait "multiple import" $ do
17271740
let source = T.unlines ["", "import Data.Maybe", "", "import Control.Exception", ""]
17281741
docId <- openDoc' "A.hs" "haskell" source
17291742
symbols <- getDocumentSymbols docId
17301743
liftIO $ symbols @?= Left
1731-
[docSymbolWithChildren "imports"
1732-
SkModule
1744+
[docSymbolWithChildren "imports"
1745+
SkModule
17331746
(R 1 0 3 24)
17341747
[ docSymbol "import Data.Maybe" SkModule (R 1 0 1 17)
1735-
, docSymbol "import Control.Exception" SkModule (R 3 0 3 24)
1748+
, docSymbol "import Control.Exception" SkModule (R 3 0 3 24)
17361749
]
17371750
]
17381751
, testSessionWait "foreign import" $ do
@@ -1909,11 +1922,20 @@ testSessionWait name = testSession name .
19091922
-- Experimentally, 0.5s seems to be long enough to wait for any final diagnostics to appear.
19101923
( >> expectNoMoreDiagnostics 0.5)
19111924

1912-
pickActionWithTitle :: T.Text -> [CAResult] -> CodeAction
1913-
pickActionWithTitle title actions = head
1914-
[ action
1915-
| CACodeAction action@CodeAction{ _title = actionTitle } <- actions
1916-
, title == actionTitle ]
1925+
pickActionWithTitle :: T.Text -> [CAResult] -> IO CodeAction
1926+
pickActionWithTitle title actions = do
1927+
assertBool ("Found no matching actions: " <> show titles) (not $ null matches)
1928+
return $ head matches
1929+
where
1930+
titles =
1931+
[ actionTitle
1932+
| CACodeAction CodeAction { _title = actionTitle } <- actions
1933+
]
1934+
matches =
1935+
[ action
1936+
| CACodeAction action@CodeAction { _title = actionTitle } <- actions
1937+
, title == actionTitle
1938+
]
19171939

19181940
mkRange :: Int -> Int -> Int -> Int -> Range
19191941
mkRange a b c d = Range (Position a b) (Position c d)

0 commit comments

Comments
 (0)