acc4a0a · ghcide · git.iko.soy

git.iko.soy/ghcide

on master help sign in

Guess more imports (#451)

acc4a0aPepe Iborra7 years ago

src/Development/IDE/Plugin/CodeAction.hs+81−22

compare with master

unifiedsplit

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

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

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

11−import Avail (availNames)

11+import Avail (AvailInfo(Avail), AvailInfo(AvailTC), availNames)

12import Language.Haskell.LSP.Types

13import Control.Monad (join)

14import Development.IDE.Plugin

@@ -41,12 +41,12 @@ import Parser

41import RdrName

42import Text.Regex.TDFA ((=~), (=~~))

43import Text.Regex.TDFA.Text()

44−import Outputable (showSDoc, ppr, showSDocUnsafe)

44+import Outputable (ppr, showSDocUnsafe)

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

46import GHC.LanguageExtensions.Type (Extension)

47−import Data.Function (on)

48import Data.IORef (readIORef)

47import Data.IORef (readIORef)

49−import Name (nameModule_maybe, nameOccName)

48+import Name (isDataConName, nameModule_maybe, nameOccName)

49+import Packages (exposedModules, lookupPackage)

51plugin :: Plugin c

52plugin = codeActionPlugin codeAction <> Plugin mempty setHandlersCodeLens

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

132 ] ++ concat

133 [ suggestNewDefinition ideOptions pm text diag

134 ++ 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]]

136 | Just pm <- [parsedModule]]

137

138

@@ -303,12 +303,16 @@ suggestExtendImport (Just dflags) contents Diagnostic{_range=_range,..}

303 in x{_end = (_end x){_character = succ (_character (_end x))}}

304 _ -> error "bug in srcspan parser"

305 importLine = textInRange range c

306− printedName = let rn = rdrNameOcc name in showSDoc dflags $ parenSymOcc rn (ppr rn)

307 in [("Add " <> binding <> " to the import list of " <> mod

306 in [("Add " <> binding <> " to the import list of " <> mod

308− , [TextEdit range (addBindingToImportList (T.pack printedName) importLine)])]

307+ , [TextEdit range (addBindingToImportList (printRdrName name) importLine)])]

309 | otherwise = []

308 | otherwise = []

310suggestExtendImport Nothing _ _ = []

309suggestExtendImport Nothing _ _ = []

311

310

311+printRdrName :: RdrName -> T.Text

312+printRdrName name = T.pack $ showSDocUnsafe $ parenSymOcc rn (ppr rn)

313+ where

314+ rn = rdrNameOcc name

315+

312suggestFixConstructorImport :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]

316suggestFixConstructorImport :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]

313suggestFixConstructorImport _ Diagnostic{_range=_range,..}

317suggestFixConstructorImport _ Diagnostic{_range=_range,..}

314 -- ‘Success’ is a data constructor of ‘Result’

318 -- ‘Success’ is a data constructor of ‘Result’

@@ -347,10 +351,12 @@ suggestSignature isQuickFix Diagnostic{_range=_range@Range{..},..}

347

351

348suggestSignature _ _ = []

352suggestSignature _ _ = []

349

353

354+-------------------------------------------------------------------------------------------------

355+

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

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

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

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

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

358+ | msg <- unifySpaces _message

353− , items <- typeEnvElts $ eps_PTE eps

359+ , Just name <- extractNotInScopeName msg

354 , Just insertLine <- case hsmodImports of

360 , Just insertLine <- case hsmodImports of

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

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

356 RealSrcLoc s -> Just $ srcLocLine s - 1

362 RealSrcLoc s -> Just $ srcLocLine s - 1

@@ -360,24 +366,77 @@ suggestNewImport eps ParsedModule {pm_parsed_source = L _ HsModule {..}} Diagnos

360 _ -> Nothing

366 _ -> Nothing

361 , insertPos <- Position insertLine 0

367 , insertPos <- Position insertLine 0

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

368 , extendImportSuggestions <- -- Just [binding, mod, srcspan] <-

363− matchRegex _message

369+ matchRegex msg

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

370 "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")]

371+ = [(imp, [TextEdit (Range insertPos insertPos) (imp <> "\n")])

370− )

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

371 | item <- items,

381 | item <- items,

372 avail <- tyThingAvailInfo item,

382 avail <- tyThingAvailInfo item,

383+ canUseAvail thingMissing avail,

373 candidate <- availNames avail,

384 candidate <- availNames avail,

385+ canUseName thingMissing candidate,

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

386 occNameString (nameOccName candidate) == T.unpack name,

375 Just m <- [nameModule_maybe candidate],

387 Just m <- [nameModule_maybe candidate],

388+ Just package <- [lookupPackage dflags (moduleUnitId m)],

389+ moduleName m `elem` map fst (exposedModules package),

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

390 let modName = T.pack $ moduleNameString $ moduleName m,

377− modName `notElem` fromMaybe [] extendImportSuggestions,

391+ modName `notElem` fromMaybe [] notTheseModules

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

379 ]

392 ]

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+-------------------------------------------------------------------------------------------------

381

440

382topOfHoleFitsMarker :: T.Text

441topOfHoleFitsMarker :: T.Text

383topOfHoleFitsMarker =

442topOfHoleFitsMarker =

@@ -511,4 +570,4 @@ filterNewlines :: T.Text -> T.Text

511filterNewlines = T.concat . T.lines

570filterNewlines = T.concat . T.lines

512

571

513unifySpaces :: T.Text -> T.Text

572unifySpaces :: T.Text -> T.Text

514−unifySpaces = T.unwords . T.words

573+unifySpaces = T.unwords . T.words

test/exe/Main.hs+44−22

@@ -899,22 +899,36 @@ extendImportTests = testGroup "extend import actions"

899suggestImportTests :: TestTree

900suggestImportTests = testGroup "suggest import actions"

901 [ testGroup "Dont want suggestion"

902+ [ -- extend import

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

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)"

903 ]

908 ]

904 , testGroup "want suggestion"

909 , testGroup "want suggestion"

905− [ test True [] "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))"

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

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)"

907 ]

922 ]

908 ]

923 ]

909 where

924 where

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

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

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

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

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

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

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

928 doc <- openDoc' "Test.hs" "haskell" before

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

929 -- load another module in the session to exercise the package cache

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

930 _ <- openDoc' "Other.hs" "haskell" after

916 _diags <- waitForDiagnostics

931 _diags <- waitForDiagnostics

917− liftIO $ print _diags

918 let defLine = length imps + 1

932 let defLine = length imps + 1

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

933 range = Range (Position defLine 0) (Position defLine maxBound)

920 actions <- getCodeActions doc range

934 actions <- getCodeActions doc range

@@ -922,8 +936,7 @@ suggestImportTests = testGroup "suggest import actions"

922 False ->

936 False ->

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

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

924 True -> do

938 True -> do

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

926− let action = pickActionWithTitle newImp actions

939+ action <- liftIO $ pickActionWithTitle newImp actions

927 executeCodeAction action

940 executeCodeAction action

928 contentAfterAction <- documentContents doc

941 contentAfterAction <- documentContents doc

929 liftIO $ after @=? contentAfterAction

942 liftIO $ after @=? contentAfterAction

@@ -1119,7 +1132,7 @@ fillTypedHoleTests = let

1119 doc <- openDoc' "Testing.hs" "haskell" originalCode

1132 doc <- openDoc' "Testing.hs" "haskell" originalCode

1120 _ <- waitForDiagnostics

1133 _ <- waitForDiagnostics

1121 actionsOrCommands <- getCodeActions doc (Range (Position 9 0) (Position 9 maxBound))

1134 actionsOrCommands <- getCodeActions doc (Range (Position 9 0) (Position 9 maxBound))

1122− let chosenAction = pickActionWithTitle actionTitle actionsOrCommands

1135+ chosenAction <- liftIO $ pickActionWithTitle actionTitle actionsOrCommands

1123 executeCodeAction chosenAction

1136 executeCodeAction chosenAction

1124 modifiedCode <- documentContents doc

1137 modifiedCode <- documentContents doc

1125 liftIO $ expectedCode @=? modifiedCode

1138 liftIO $ expectedCode @=? modifiedCode

@@ -1167,7 +1180,7 @@ addSigActionTests = let

1167 doc <- openDoc' "Sigs.hs" "haskell" originalCode

1180 doc <- openDoc' "Sigs.hs" "haskell" originalCode

1168 _ <- waitForDiagnostics

1181 _ <- waitForDiagnostics

1169 actionsOrCommands <- getCodeActions doc (Range (Position 3 1) (Position 3 maxBound))

1182 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

1171 executeCodeAction chosenAction

1184 executeCodeAction chosenAction

1172 modifiedCode <- documentContents doc

1185 modifiedCode <- documentContents doc

1173 liftIO $ expectedCode @=? modifiedCode

1186 liftIO $ expectedCode @=? modifiedCode

@@ -1717,10 +1730,10 @@ outlineTests = testGroup

1717 docId <- openDoc' "A.hs" "haskell" source

1730 docId <- openDoc' "A.hs" "haskell" source

1718 symbols <- getDocumentSymbols docId

1731 symbols <- getDocumentSymbols docId

1719 liftIO $ symbols @?= Left

1732 liftIO $ symbols @?= Left

1720− [docSymbolWithChildren "imports"

1733+ [docSymbolWithChildren "imports"

1721− SkModule

1734+ SkModule

1722 (R 0 0 0 17)

1735 (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)

1724 ]

1737 ]

1725 ]

1738 ]

1726 , testSessionWait "multiple import" $ do

1739 , testSessionWait "multiple import" $ do

@@ -1728,11 +1741,11 @@ outlineTests = testGroup

1728 docId <- openDoc' "A.hs" "haskell" source

1741 docId <- openDoc' "A.hs" "haskell" source

1729 symbols <- getDocumentSymbols docId

1742 symbols <- getDocumentSymbols docId

1730 liftIO $ symbols @?= Left

1743 liftIO $ symbols @?= Left

1731− [docSymbolWithChildren "imports"

1744+ [docSymbolWithChildren "imports"

1732− SkModule

1745+ SkModule

1733 (R 1 0 3 24)

1746 (R 1 0 3 24)

1734 [ docSymbol "import Data.Maybe" SkModule (R 1 0 1 17)

1747 [ 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)

1736 ]

1749 ]

1737 ]

1750 ]

1738 , testSessionWait "foreign import" $ do

1751 , testSessionWait "foreign import" $ do

@@ -1909,11 +1922,20 @@ testSessionWait name = testSession name .

1909 -- Experimentally, 0.5s seems to be long enough to wait for any final diagnostics to appear.

1922 -- Experimentally, 0.5s seems to be long enough to wait for any final diagnostics to appear.

1910 ( >> expectNoMoreDiagnostics 0.5)

1923 ( >> expectNoMoreDiagnostics 0.5)

1911

1924

1912−pickActionWithTitle :: T.Text -> [CAResult] -> CodeAction

1925+pickActionWithTitle :: T.Text -> [CAResult] -> IO CodeAction

1913−pickActionWithTitle title actions = head

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 =

1914− [ action

1935+ [ action

1915− | CACodeAction action@CodeAction{ _title = actionTitle } <- actions

1936+ | CACodeAction action@CodeAction { _title = actionTitle } <- actions

1916− , title == actionTitle ]

1937+ , title == actionTitle

1938+ ]

1917

1939

1918mkRange :: Int -> Int -> Int -> Int -> Range

1940mkRange :: Int -> Int -> Int -> Int -> Range

1919mkRange a b c d = Range (Position a b) (Position c d)

1941mkRange a b c d = Range (Position a b) (Position c d)