14b0b16 · ghcide · git.iko.soy

git.iko.soy/ghcide

Merge pull request #27 from hsenag/type-wildcards

Code action for type wildcards

commit14b0b16aecbdc54d531c6381a7b3dedae5fef202 authorMoritz Kiefer <moritz.kiefer@purelyfunctional.org> dateThu 12 Sep 2019, 15:58 (7 years ago) parentf455375 de35c8f

2 files changed+87

compare with master

unifiedsplit

src/Development/IDE/LSP/CodeAction.hs+16 test/exe/Main.hs+71

src/Development/IDE/LSP/CodeAction.hs+16

@@ -65,6 +65,14 @@ suggestAction contents Diagnostic{_range=_range@Range{..},..}

6565 | renameSuggestions@(_:_) <- extractRenamableTerms _message

6666 = [ ("Replace with ‘" <> name <> "’", [mkRenameEdit contents _range name]) | name <- renameSuggestions ]

6767

68+-- Foo.hs:3:8: error:

69+-- * Found type wildcard `_' standing for `p -> p1 -> p'

70+

71+ | "Found type wildcard" `T.isInfixOf` _message

72+ , " standing for " `T.isInfixOf` _message

73+ , typeSignature <- extractWildCardTypeSignature _message

74+ = [("Use type signature: ‘" <> typeSignature <> "’", [TextEdit _range typeSignature])]

75+

6876-- File.hs:22:8: error:

6977-- Illegal lambda-case (use -XLambdaCase)

7078-- File.hs:22:6: error:

@@ -100,6 +108,14 @@ mkRenameEdit contents range name =

100108 curr <- textInRange range <$> contents

101109 pure $ "`" `T.isPrefixOf` curr && "`" `T.isSuffixOf` curr

102110

111+extractWildCardTypeSignature :: T.Text -> T.Text

112+extractWildCardTypeSignature =

113+ -- inferring when parens are actually needed around the type signature would

114+ -- require understanding both the precedence of the context of the _ and of

115+ -- the signature itself. Inserting them unconditionally is ugly but safe.

116+ ("(" `T.append`) . (`T.append` ")") .

117+ T.takeWhile (/='’') . T.dropWhile (=='‘') . T.dropWhile (/='‘') .

118+ snd . T.breakOnEnd "standing for "

103119

104120extractRenamableTerms :: T.Text -> [T.Text]

105121extractRenamableTerms msg

test/exe/Main.hs+71

@@ -211,6 +211,7 @@ diagnosticTests = testGroup "diagnostics"

211211codeActionTests :: TestTree

212212codeActionTests = testGroup "code actions"

213213 [ renameActionTests

214+ , typeWildCardActionTests

214215 ]

215216

216217renameActionTests :: TestTree

@@ -289,6 +290,76 @@ renameActionTests = testGroup "rename actions"

289290 liftIO $ expectedContentAfterAction @=? contentAfterAction

290291 ]

291292

293+typeWildCardActionTests :: TestTree

294+typeWildCardActionTests = testGroup "type wildcard actions"

295+ [ testSession "global signature" $ do

296+ let content = T.unlines

297+ [ "module Testing where"

298+ , "func :: _"

299+ , "func x = x"

300+ ]

301+ doc <- openDoc' "Testing.hs" "haskell" content

302+ _ <- waitForDiagnostics

303+ actionsOrCommands <- getCodeActions doc (Range (Position 2 1) (Position 2 10))

304+ let [addSignature] = [action | CACodeAction action@CodeAction { _title = actionTitle } <- actionsOrCommands

305+ , "Use type signature" `T.isInfixOf` actionTitle

306+ ]

307+ executeCodeAction addSignature

308+ contentAfterAction <- documentContents doc

309+ let expectedContentAfterAction = T.unlines

310+ [ "module Testing where"

311+ , "func :: (p -> p)"

312+ , "func x = x"

313+ ]

314+ liftIO $ expectedContentAfterAction @=? contentAfterAction

315+ , testSession "multi-line message" $ do

316+ let content = T.unlines

317+ [ "module Testing where"

318+ , "func :: _"

319+ , "func x y = x + y"

320+ ]

321+ doc <- openDoc' "Testing.hs" "haskell" content

322+ _ <- waitForDiagnostics

323+ actionsOrCommands <- getCodeActions doc (Range (Position 2 1) (Position 2 10))

324+ let [addSignature] = [action | CACodeAction action@CodeAction { _title = actionTitle } <- actionsOrCommands

325+ , "Use type signature" `T.isInfixOf` actionTitle

326+ ]

327+ executeCodeAction addSignature

328+ contentAfterAction <- documentContents doc

329+ let expectedContentAfterAction = T.unlines

330+ [ "module Testing where"

331+ , "func :: (Integer -> Integer -> Integer)"

332+ , "func x y = x + y"

333+ ]

334+ liftIO $ expectedContentAfterAction @=? contentAfterAction

335+ , testSession "local signature" $ do

336+ let content = T.unlines

337+ [ "module Testing where"

338+ , "func :: Int -> Int"

339+ , "func x ="

340+ , " let y :: _"

341+ , " y = x * 2"

342+ , " in y"

343+ ]

344+ doc <- openDoc' "Testing.hs" "haskell" content

345+ _ <- waitForDiagnostics

346+ actionsOrCommands <- getCodeActions doc (Range (Position 4 1) (Position 4 10))

347+ let [addSignature] = [action | CACodeAction action@CodeAction { _title = actionTitle } <- actionsOrCommands

348+ , "Use type signature" `T.isInfixOf` actionTitle

349+ ]

350+ executeCodeAction addSignature

351+ contentAfterAction <- documentContents doc

352+ let expectedContentAfterAction = T.unlines

353+ [ "module Testing where"

354+ , "func :: Int -> Int"

355+ , "func x ="

356+ , " let y :: (Int)"

357+ , " y = x * 2"

358+ , " in y"

359+ ]

360+ liftIO $ expectedContentAfterAction @=? contentAfterAction

361+ ]

362+

292363----------------------------------------------------------------------

293364-- Utils

294365