git.iko.soy/ghcide
on master help sign in
Merge pull request #27 from hsenag/type-wildcards
14b0b16Moritz Kiefer
src/Development/IDE/LSP/CodeAction.hs+16
compare with master
unifiedsplit
@@ -65,6 +65,14 @@ suggestAction contents Diagnostic{_range=_range@Range{..},..}
65 | renameSuggestions@(_:_) <- extractRenamableTerms _message
65 | renameSuggestions@(_:_) <- extractRenamableTerms _message
66 = [ ("Replace with ‘" <> name <> "’", [mkRenameEdit contents _range name]) | name <- renameSuggestions ]
66 = [ ("Replace with ‘" <> name <> "’", [mkRenameEdit contents _range name]) | name <- renameSuggestions ]
67
67
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+
68-- File.hs:22:8: error:
76-- File.hs:22:8: error:
69-- Illegal lambda-case (use -XLambdaCase)
77-- Illegal lambda-case (use -XLambdaCase)
70-- File.hs:22:6: error:
78-- File.hs:22:6: error:
@@ -100,6 +108,14 @@ mkRenameEdit contents range name =
100 curr <- textInRange range <$> contents
108 curr <- textInRange range <$> contents
101 pure $ "`" `T.isPrefixOf` curr && "`" `T.isSuffixOf` curr
109 pure $ "`" `T.isPrefixOf` curr && "`" `T.isSuffixOf` curr
102
110
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 "
103
119
104extractRenamableTerms :: T.Text -> [T.Text]
120extractRenamableTerms :: T.Text -> [T.Text]
105extractRenamableTerms msg
121extractRenamableTerms msg
test/exe/Main.hs+71
@@ -211,6 +211,7 @@ diagnosticTests = testGroup "diagnostics"
211codeActionTests :: TestTree
211codeActionTests :: TestTree
212codeActionTests = testGroup "code actions"
212codeActionTests = testGroup "code actions"
213 [ renameActionTests
213 [ renameActionTests
214+ , typeWildCardActionTests
214 ]
215 ]
215
216
216renameActionTests :: TestTree
217renameActionTests :: TestTree
@@ -289,6 +290,76 @@ renameActionTests = testGroup "rename actions"
289 liftIO $ expectedContentAfterAction @=? contentAfterAction
290 liftIO $ expectedContentAfterAction @=? contentAfterAction
290 ]
291 ]
291
292
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+
292----------------------------------------------------------------------
363----------------------------------------------------------------------
293-- Utils
364-- Utils
294
365