mirror of
https://github.com/haskell/ghcide.git
synced 2024-09-11 05:36:09 +03:00
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
This commit is contained in:
parent
9a5ee23c01
commit
4fc09fafa2
@ -81,7 +81,9 @@
|
||||
- Development.IDE.GHC.Compat
|
||||
- Development.IDE.GHC.Util
|
||||
- Development.IDE.Import.FindImports
|
||||
- Development.IDE.LSP.CodeAction
|
||||
- Development.IDE.Spans.Calculate
|
||||
- Main
|
||||
|
||||
- flags:
|
||||
- default: false
|
||||
|
@ -171,6 +171,14 @@ test-suite ghcide-tests
|
||||
containers,
|
||||
extra,
|
||||
filepath,
|
||||
--------------------------------------------------------------
|
||||
-- The MIN_GHC_API_VERSION macro relies on MIN_VERSION pragmas
|
||||
-- which require depending on ghc. So the tests need to depend
|
||||
-- on ghc if they need to use MIN_GHC_API_VERSION. Maybe a
|
||||
-- better solution can be found, but this is a quick solution
|
||||
-- which works for now.
|
||||
ghc,
|
||||
--------------------------------------------------------------
|
||||
haskell-lsp-types,
|
||||
lens,
|
||||
lsp-test,
|
||||
@ -179,6 +187,7 @@ test-suite ghcide-tests
|
||||
tasty-hunit,
|
||||
text
|
||||
hs-source-dirs: test/cabal test/exe test/src
|
||||
include-dirs: include
|
||||
ghc-options: -threaded
|
||||
main-is: Main.hs
|
||||
other-modules:
|
||||
|
@ -2,6 +2,8 @@
|
||||
-- SPDX-License-Identifier: Apache-2.0
|
||||
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
#include "ghc-api-version.h"
|
||||
|
||||
-- | Go to the definition of a variable.
|
||||
module Development.IDE.LSP.CodeAction
|
||||
@ -102,13 +104,52 @@ suggestAction contents Diagnostic{_range=_range@Range{..},..}
|
||||
-- Could not find module ‘Data.Cha’
|
||||
-- Perhaps you meant Data.Char (from base-4.12.0.0)
|
||||
| "Could not find module" `T.isInfixOf` _message
|
||||
, "Perhaps you meant" `T.isInfixOf` _message
|
||||
= map proposeModule $ nubOrd $ findSuggestedModules _message where
|
||||
, "Perhaps you meant" `T.isInfixOf` _message = let
|
||||
findSuggestedModules = map (head . T.words) . drop 2 . T.lines
|
||||
proposeModule mod = ("replace with " <> mod, [TextEdit _range mod])
|
||||
in map proposeModule $ nubOrd $ findSuggestedModules _message
|
||||
|
||||
-- ...Development/IDE/LSP/CodeAction.hs:103:9: warning:
|
||||
-- * Found hole: _ :: Int -> String
|
||||
-- * In the expression: _
|
||||
-- In the expression: _ a
|
||||
-- In an equation for ‘foo’: foo a = _ a
|
||||
-- * Relevant bindings include
|
||||
-- a :: Int
|
||||
-- (bound at ...Development/IDE/LSP/CodeAction.hs:103:5)
|
||||
-- foo :: Int -> String
|
||||
-- (bound at ...Development/IDE/LSP/CodeAction.hs:103:1)
|
||||
-- Valid hole fits include
|
||||
-- foo :: Int -> String
|
||||
-- (bound at ...Development/IDE/LSP/CodeAction.hs:103:1)
|
||||
-- show :: forall a. Show a => a -> String
|
||||
-- with show @Int
|
||||
-- (imported from ‘Prelude’ at ...Development/IDE/LSP/CodeAction.hs:7:8-37
|
||||
-- (and originally defined in ‘GHC.Show’))
|
||||
-- mempty :: forall a. Monoid a => a
|
||||
-- with mempty @(Int -> String)
|
||||
-- (imported from ‘Prelude’ at ...Development/IDE/LSP/CodeAction.hs:7:8-37
|
||||
-- (and originally defined in ‘GHC.Base’)) (lsp-ui)
|
||||
|
||||
| topOfHoleFitsMarker `T.isInfixOf` _message = let
|
||||
findSuggestedHoleFits :: T.Text -> [T.Text]
|
||||
findSuggestedHoleFits = extractFitNames . selectLinesWithFits . dropPreceding . T.lines
|
||||
proposeHoleFit name = ("replace hole `" <> holeName <> "` with " <> name, [TextEdit _range name])
|
||||
holeName = T.strip $ last $ T.splitOn ":" $ head . T.splitOn "::" $ head $ filter ("Found hole" `T.isInfixOf`) $ T.lines _message
|
||||
dropPreceding = dropWhile (not . (topOfHoleFitsMarker `T.isInfixOf`))
|
||||
selectLinesWithFits = filter ("::" `T.isInfixOf`)
|
||||
extractFitNames = map (T.strip . head . T.splitOn " :: ")
|
||||
in map proposeHoleFit $ nubOrd $ findSuggestedHoleFits _message
|
||||
|
||||
suggestAction _ _ = []
|
||||
|
||||
topOfHoleFitsMarker =
|
||||
#if MIN_GHC_API_VERSION(8,6,0)
|
||||
"Valid hole fits include"
|
||||
#else
|
||||
"Valid substitutions include"
|
||||
#endif
|
||||
|
||||
mkRenameEdit :: Maybe T.Text -> Range -> T.Text -> TextEdit
|
||||
mkRenameEdit contents range name =
|
||||
if fromMaybe False maybeIsInfixFunction
|
||||
|
@ -2,6 +2,8 @@
|
||||
-- SPDX-License-Identifier: Apache-2.0
|
||||
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
#include "ghc-api-version.h"
|
||||
|
||||
module Main (main) where
|
||||
|
||||
@ -232,6 +234,7 @@ codeActionTests = testGroup "code actions"
|
||||
, typeWildCardActionTests
|
||||
, removeImportTests
|
||||
, importRenameActionTests
|
||||
, fillTypedHoleTests
|
||||
]
|
||||
|
||||
renameActionTests :: TestTree
|
||||
@ -453,6 +456,75 @@ importRenameActionTests = testGroup "import rename actions"
|
||||
]
|
||||
liftIO $ expectedContentAfterAction @=? contentAfterAction
|
||||
|
||||
fillTypedHoleTests :: TestTree
|
||||
fillTypedHoleTests = let
|
||||
|
||||
sourceCode :: T.Text -> T.Text -> T.Text -> T.Text
|
||||
sourceCode a b c = T.unlines
|
||||
[ "module Testing where"
|
||||
, ""
|
||||
, "globalConvert :: Int -> String"
|
||||
, "globalConvert = undefined"
|
||||
, ""
|
||||
, "globalInt :: Int"
|
||||
, "globalInt = 3"
|
||||
, ""
|
||||
, "bar :: Int -> Int -> String"
|
||||
, "bar n parameterInt = " <> a <> " (n + " <> b <> " + " <> c <> ") where"
|
||||
, " localConvert = (flip replicate) 'x'"
|
||||
|
||||
]
|
||||
|
||||
check :: T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> TestTree
|
||||
check actionTitle
|
||||
oldA oldB oldC
|
||||
newA newB newC = testSession (T.unpack actionTitle) $ do
|
||||
let originalCode = sourceCode oldA oldB oldC
|
||||
let expectedCode = sourceCode newA newB newC
|
||||
doc <- openDoc' "Testing.hs" "haskell" originalCode
|
||||
_ <- waitForDiagnostics
|
||||
actionsOrCommands <- getCodeActions doc (Range (Position 9 0) (Position 9 maxBound))
|
||||
let chosenAction = pickActionWithTitle actionTitle actionsOrCommands
|
||||
executeCodeAction chosenAction
|
||||
modifiedCode <- documentContents doc
|
||||
liftIO $ expectedCode @=? modifiedCode
|
||||
|
||||
pickActionWithTitle title actions = head
|
||||
[ action
|
||||
| CACodeAction action@CodeAction{ _title = actionTitle } <- actions
|
||||
, title == actionTitle ]
|
||||
|
||||
in
|
||||
testGroup "fill typed holes"
|
||||
[ check "replace hole `_` with show"
|
||||
"_" "n" "n"
|
||||
"show" "n" "n"
|
||||
|
||||
, check "replace hole `_` with globalConvert"
|
||||
"_" "n" "n"
|
||||
"globalConvert" "n" "n"
|
||||
|
||||
#if MIN_GHC_API_VERSION(8,6,0)
|
||||
, check "replace hole `_convertme` with localConvert"
|
||||
"_convertme" "n" "n"
|
||||
"localConvert" "n" "n"
|
||||
#endif
|
||||
|
||||
, check "replace hole `_b` with globalInt"
|
||||
"_a" "_b" "_c"
|
||||
"_a" "globalInt" "_c"
|
||||
|
||||
, check "replace hole `_c` with globalInt"
|
||||
"_a" "_b" "_c"
|
||||
"_a" "_b" "globalInt"
|
||||
|
||||
#if MIN_GHC_API_VERSION(8,6,0)
|
||||
, check "replace hole `_c` with parameterInt"
|
||||
"_a" "_b" "_c"
|
||||
"_a" "_b" "parameterInt"
|
||||
#endif
|
||||
]
|
||||
|
||||
----------------------------------------------------------------------
|
||||
-- Utils
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user