@@ -8,7 +8,7 @@
88-- | Go to the definition of a variable.
99module Development.IDE.Plugin.CodeAction(plugin) where
1010
11−import Avail (availNames)
11+import Avail (AvailInfo(Avail), AvailInfo(AvailTC), availNames)
1212import Language.Haskell.LSP.Types
1313import Control.Monad (join)
1414import Development.IDE.Plugin
@@ -41,12 +41,12 @@ import Parser
4141import RdrName
4242import Text.Regex.TDFA ((=~), (=~~))
4343import Text.Regex.TDFA.Text()
44−import Outputable (showSDoc, ppr, showSDocUnsafe)
44+import Outputable (ppr, showSDocUnsafe)
4545import DynFlags (xFlags, FlagSpec(..))
4646import GHC.LanguageExtensions.Type (Extension)
47−import Data.Function (on)
4847import Data.IORef (readIORef)
49−import Name (nameModule_maybe, nameOccName)
48+import Name (isDataConName, nameModule_maybe, nameOccName)
49+import Packages (exposedModules, lookupPackage)
5050
5151plugin :: Plugin c
5252plugin = 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 = []
310309suggestExtendImport Nothing _ _ = []
311310
311+printRdrName :: RdrName -> T.Text
312+printRdrName name = T.pack $ showSDocUnsafe $ parenSymOcc rn (ppr rn)
313+ where
314+ rn = rdrNameOcc name
315+
312316suggestFixConstructorImport :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
313317suggestFixConstructorImport _ Diagnostic{_range=_range,..}
314318 -- ‘Success’ is a data constructor of ‘Result’
@@ -347,10 +351,12 @@ suggestSignature isQuickFix Diagnostic{_range=_range@Range{..},..}
347351
348352suggestSignature _ _ = []
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
382441topOfHoleFitsMarker :: T.Text
383442topOfHoleFitsMarker =
@@ -511,4 +570,4 @@ filterNewlines :: T.Text -> T.Text
511570filterNewlines = T.concat . T.lines
512571
513572unifySpaces :: T.Text -> T.Text
514−unifySpaces = T.unwords . T.words
573+unifySpaces = T.unwords . T.words