git.iko.soy/ghcide
on master help sign in
Code actions for filling typed holes (#69)

* Add code action for filling type holes * Incorporate hole name into action title Useful if more than one hole appears on the same line. Not so useful if both of these holes are just `_` rather than `_name` (or more than one hole on the same line has the same `_name`): In which case perhaps some numbers could be attached to the action titles, to distinguish the holes. But I suspect that this would not be worth the effort. * Add tests for fill-type-hole actions * Disable two tests on GHC 8.4 These test hints about local bindings, whic GHC 8.4 does not provide. * Replace compilerVersion with new MIN_GHC_API_VERSION macro

commit4fc09fafa2db7a51c2d078c9323539f4fe8d8844 authorjacg <jacg@my-post-office.net> dateMon 16 Sep 2019, 16:43 (7 years ago) parent9a5ee23
4 files changed+126−2
compare with master
unifiedsplit
.hlint.yaml+2 ghcide.cabal+9 src/Development/IDE/LSP/CodeAction.hs+43−2 test/exe/Main.hs+72
.hlint.yaml+2
@@ -81,7 +81,9 @@
8181 - Development.IDE.GHC.Compat
8282 - Development.IDE.GHC.Util
8383 - Development.IDE.Import.FindImports
84+ - Development.IDE.LSP.CodeAction
8485 - Development.IDE.Spans.Calculate
86+ - Main
8587
8688- flags:
8789 - default: false
ghcide.cabal+9
@@ -171,6 +171,14 @@ test-suite ghcide-tests
171171 containers,
172172 extra,
173173 filepath,
174+ --------------------------------------------------------------
175+ -- The MIN_GHC_API_VERSION macro relies on MIN_VERSION pragmas
176+ -- which require depending on ghc. So the tests need to depend
177+ -- on ghc if they need to use MIN_GHC_API_VERSION. Maybe a
178+ -- better solution can be found, but this is a quick solution
179+ -- which works for now.
180+ ghc,
181+ --------------------------------------------------------------
174182 haskell-lsp-types,
175183 lens,
176184 lsp-test,
@@ -179,6 +187,7 @@ test-suite ghcide-tests
179187 tasty-hunit,
180188 text
181189 hs-source-dirs: test/cabal test/exe test/src
190+ include-dirs: include
182191 ghc-options: -threaded
183192 main-is: Main.hs
184193 other-modules:
src/Development/IDE/LSP/CodeAction.hs+43−2
@@ -2,6 +2,8 @@
22-- SPDX-License-Identifier: Apache-2.0
33
44{-# LANGUAGE DuplicateRecordFields #-}
5+{-# LANGUAGE CPP #-}
6+#include "ghc-api-version.h"
57
68-- | Go to the definition of a variable.
79module Development.IDE.LSP.CodeAction
@@ -102,13 +104,52 @@ suggestAction contents Diagnostic{_range=_range@Range{..},..}
102104-- Could not find module ‘Data.Cha’
103105-- Perhaps you meant Data.Char (from base-4.12.0.0)
104106 | "Could not find module" `T.isInfixOf` _message
105− , "Perhaps you meant" `T.isInfixOf` _message
106− = map proposeModule $ nubOrd $ findSuggestedModules _message where
107+ , "Perhaps you meant" `T.isInfixOf` _message = let
107108 findSuggestedModules = map (head . T.words) . drop 2 . T.lines
108109 proposeModule mod = ("replace with " <> mod, [TextEdit _range mod])
110+ in map proposeModule $ nubOrd $ findSuggestedModules _message
111+
112+-- ...Development/IDE/LSP/CodeAction.hs:103:9: warning:
113+-- * Found hole: _ :: Int -> String
114+-- * In the expression: _
115+-- In the expression: _ a
116+-- In an equation for ‘foo’: foo a = _ a
117+-- * Relevant bindings include
118+-- a :: Int
119+-- (bound at ...Development/IDE/LSP/CodeAction.hs:103:5)
120+-- foo :: Int -> String
121+-- (bound at ...Development/IDE/LSP/CodeAction.hs:103:1)
122+-- Valid hole fits include
123+-- foo :: Int -> String
124+-- (bound at ...Development/IDE/LSP/CodeAction.hs:103:1)
125+-- show :: forall a. Show a => a -> String
126+-- with show @Int
127+-- (imported from ‘Prelude’ at ...Development/IDE/LSP/CodeAction.hs:7:8-37
128+-- (and originally defined in ‘GHC.Show’))
129+-- mempty :: forall a. Monoid a => a
130+-- with mempty @(Int -> String)
131+-- (imported from ‘Prelude’ at ...Development/IDE/LSP/CodeAction.hs:7:8-37
132+-- (and originally defined in ‘GHC.Base’)) (lsp-ui)
133+
134+ | topOfHoleFitsMarker `T.isInfixOf` _message = let
135+ findSuggestedHoleFits :: T.Text -> [T.Text]
136+ findSuggestedHoleFits = extractFitNames . selectLinesWithFits . dropPreceding . T.lines
137+ proposeHoleFit name = ("replace hole `" <> holeName <> "` with " <> name, [TextEdit _range name])
138+ holeName = T.strip $ last $ T.splitOn ":" $ head . T.splitOn "::" $ head $ filter ("Found hole" `T.isInfixOf`) $ T.lines _message
139+ dropPreceding = dropWhile (not . (topOfHoleFitsMarker `T.isInfixOf`))
140+ selectLinesWithFits = filter ("::" `T.isInfixOf`)
141+ extractFitNames = map (T.strip . head . T.splitOn " :: ")
142+ in map proposeHoleFit $ nubOrd $ findSuggestedHoleFits _message
109143
110144suggestAction _ _ = []
111145
146+topOfHoleFitsMarker =
147+#if MIN_GHC_API_VERSION(8,6,0)
148+ "Valid hole fits include"
149+#else
150+ "Valid substitutions include"
151+#endif
152+
112153mkRenameEdit :: Maybe T.Text -> Range -> T.Text -> TextEdit
113154mkRenameEdit contents range name =
114155 if fromMaybe False maybeIsInfixFunction
test/exe/Main.hs+72
@@ -2,6 +2,8 @@
22-- SPDX-License-Identifier: Apache-2.0
33
44{-# LANGUAGE DuplicateRecordFields #-}
5+{-# LANGUAGE CPP #-}
6+#include "ghc-api-version.h"
57
68module Main (main) where
79
@@ -232,6 +234,7 @@ codeActionTests = testGroup "code actions"
232234 , typeWildCardActionTests
233235 , removeImportTests
234236 , importRenameActionTests
237+ , fillTypedHoleTests
235238 ]
236239
237240renameActionTests :: TestTree
@@ -453,6 +456,75 @@ importRenameActionTests = testGroup "import rename actions"
453456 ]
454457 liftIO $ expectedContentAfterAction @=? contentAfterAction
455458
459+fillTypedHoleTests :: TestTree
460+fillTypedHoleTests = let
461+
462+ sourceCode :: T.Text -> T.Text -> T.Text -> T.Text
463+ sourceCode a b c = T.unlines
464+ [ "module Testing where"
465+ , ""
466+ , "globalConvert :: Int -> String"
467+ , "globalConvert = undefined"
468+ , ""
469+ , "globalInt :: Int"
470+ , "globalInt = 3"
471+ , ""
472+ , "bar :: Int -> Int -> String"
473+ , "bar n parameterInt = " <> a <> " (n + " <> b <> " + " <> c <> ") where"
474+ , " localConvert = (flip replicate) 'x'"
475+
476+ ]
477+
478+ check :: T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> TestTree
479+ check actionTitle
480+ oldA oldB oldC
481+ newA newB newC = testSession (T.unpack actionTitle) $ do
482+ let originalCode = sourceCode oldA oldB oldC
483+ let expectedCode = sourceCode newA newB newC
484+ doc <- openDoc' "Testing.hs" "haskell" originalCode
485+ _ <- waitForDiagnostics
486+ actionsOrCommands <- getCodeActions doc (Range (Position 9 0) (Position 9 maxBound))
487+ let chosenAction = pickActionWithTitle actionTitle actionsOrCommands
488+ executeCodeAction chosenAction
489+ modifiedCode <- documentContents doc
490+ liftIO $ expectedCode @=? modifiedCode
491+
492+ pickActionWithTitle title actions = head
493+ [ action
494+ | CACodeAction action@CodeAction{ _title = actionTitle } <- actions
495+ , title == actionTitle ]
496+
497+ in
498+ testGroup "fill typed holes"
499+ [ check "replace hole `_` with show"
500+ "_" "n" "n"
501+ "show" "n" "n"
502+
503+ , check "replace hole `_` with globalConvert"
504+ "_" "n" "n"
505+ "globalConvert" "n" "n"
506+
507+#if MIN_GHC_API_VERSION(8,6,0)
508+ , check "replace hole `_convertme` with localConvert"
509+ "_convertme" "n" "n"
510+ "localConvert" "n" "n"
511+#endif
512+
513+ , check "replace hole `_b` with globalInt"
514+ "_a" "_b" "_c"
515+ "_a" "globalInt" "_c"
516+
517+ , check "replace hole `_c` with globalInt"
518+ "_a" "_b" "_c"
519+ "_a" "_b" "globalInt"
520+
521+#if MIN_GHC_API_VERSION(8,6,0)
522+ , check "replace hole `_c` with parameterInt"
523+ "_a" "_b" "_c"
524+ "_a" "_b" "parameterInt"
525+#endif
526+ ]
527+
456528----------------------------------------------------------------------
457529-- Utils
458530