de35c8f · ghcide · git.iko.soy

git.iko.soy/ghcide

Code action to fill in GHC's suggested type signature for _

commitde35c8fe99c2a3cb916b68d1d6ee5ddfabc3af5a authorGanesh Sittampalam <ganesh@earth.li> dateWed 11 Sep 2019, 09:28 (7 years ago) parenteb81835

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

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

187187codeActionTests :: TestTree

188188codeActionTests = testGroup "code actions"

189189 [ renameActionTests

190+ , typeWildCardActionTests

190191 ]

191192

192193renameActionTests :: TestTree

@@ -265,6 +266,76 @@ renameActionTests = testGroup "rename actions"

265266 liftIO $ expectedContentAfterAction @=? contentAfterAction

266267 ]

267268

269+typeWildCardActionTests :: TestTree

270+typeWildCardActionTests = testGroup "type wildcard actions"

271+ [ testSession "global signature" $ do

272+ let content = T.unlines

273+ [ "module Testing where"

274+ , "func :: _"

275+ , "func x = x"

276+ ]

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

278+ _ <- waitForDiagnostics

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

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

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

282+ ]

283+ executeCodeAction addSignature

284+ contentAfterAction <- documentContents doc

285+ let expectedContentAfterAction = T.unlines

286+ [ "module Testing where"

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

288+ , "func x = x"

289+ ]

290+ liftIO $ expectedContentAfterAction @=? contentAfterAction

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

292+ let content = T.unlines

293+ [ "module Testing where"

294+ , "func :: _"

295+ , "func x y = x + y"

296+ ]

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

298+ _ <- waitForDiagnostics

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

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

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

302+ ]

303+ executeCodeAction addSignature

304+ contentAfterAction <- documentContents doc

305+ let expectedContentAfterAction = T.unlines

306+ [ "module Testing where"

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

308+ , "func x y = x + y"

309+ ]

310+ liftIO $ expectedContentAfterAction @=? contentAfterAction

311+ , testSession "local signature" $ do

312+ let content = T.unlines

313+ [ "module Testing where"

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

315+ , "func x ="

316+ , " let y :: _"

317+ , " y = x * 2"

318+ , " in y"

319+ ]

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

321+ _ <- waitForDiagnostics

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

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

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

325+ ]

326+ executeCodeAction addSignature

327+ contentAfterAction <- documentContents doc

328+ let expectedContentAfterAction = T.unlines

329+ [ "module Testing where"

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

331+ , "func x ="

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

333+ , " y = x * 2"

334+ , " in y"

335+ ]

336+ liftIO $ expectedContentAfterAction @=? contentAfterAction

337+ ]

338+

268339----------------------------------------------------------------------

269340-- Utils

270341