Skip to content

Keep instance lenses stable even if parsed results are unavailable #3545

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 5 commits into from
Apr 8, 2023
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
19 changes: 11 additions & 8 deletions plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@ import Data.Aeson
import Data.Maybe (mapMaybe, maybeToList)
import qualified Data.Text as T
import Development.IDE
import Development.IDE.Core.PositionMapping
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Compat.Util
import GHC.LanguageExtensions.Type
Expand All @@ -26,17 +27,17 @@ import qualified Language.LSP.Types.Lens as J
codeLens :: PluginMethodHandler IdeState TextDocumentCodeLens
codeLens state plId CodeLensParams{..} = pluginResponse $ do
nfp <- getNormalizedFilePath uri
tmr <- handleMaybeM "Unable to typecheck"
(tmr, _) <- handleMaybeM "Unable to typecheck"
$ liftIO
$ runAction "classplugin.TypeCheck" state
$ use TypeCheck nfp
$ useWithStale TypeCheck nfp

-- All instance binds
InstanceBindTypeSigsResult allBinds <-
(InstanceBindTypeSigsResult allBinds, mp) <-
handleMaybeM "Unable to get InstanceBindTypeSigsResult"
$ liftIO
$ runAction "classplugin.GetInstanceBindTypeSigs" state
$ use GetInstanceBindTypeSigs nfp
$ useWithStale GetInstanceBindTypeSigs nfp

pragmaInsertion <- insertPragmaIfNotPresent state nfp InstanceSigs

Expand All @@ -53,7 +54,7 @@ codeLens state plId CodeLensParams{..} = pluginResponse $ do
makeLens (range, title) =
generateLens plId range title
$ workspaceEdit pragmaInsertion
$ makeEdit range title
$ makeEdit range title mp
codeLens = makeLens <$> mapMaybe getRangeWithSig targetSigs

pure $ List codeLens
Expand Down Expand Up @@ -130,12 +131,14 @@ codeLens state plId CodeLensParams{..} = pluginResponse $ do
let cmd = mkLspCommand plId typeLensCommandId title (Just [toJSON edit])
in CodeLens range (Just cmd) Nothing

makeEdit :: Range -> T.Text -> [TextEdit]
makeEdit range bind =
makeEdit :: Range -> T.Text -> PositionMapping -> [TextEdit]
makeEdit range bind mp =
let startPos = range ^. J.start
insertChar = startPos ^. J.character
insertRange = Range startPos startPos
in [TextEdit insertRange (bind <> "\n" <> T.replicate (fromIntegral insertChar) " ")]
in case toCurrentRange mp insertRange of
Just rg -> [TextEdit rg (bind <> "\n" <> T.replicate (fromIntegral insertChar) " ")]
Nothing -> []

codeLensCommandHandler :: CommandFunction IdeState WorkspaceEdit
codeLensCommandHandler _ wedit = do
Expand Down
4 changes: 2 additions & 2 deletions plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -59,10 +59,10 @@ insertPragmaIfNotPresent state nfp pragma = do
(_, fileContents) <- liftIO
$ runAction "classplugin.insertPragmaIfNotPresent.GetFileContents" state
$ getFileContents nfp
pm <- handleMaybeM "Unable to GetParsedModuleWithComments"
(pm, _) <- handleMaybeM "Unable to GetParsedModuleWithComments"
$ liftIO
$ runAction "classplugin.insertPragmaIfNotPresent.GetParsedModuleWithComments" state
$ use GetParsedModuleWithComments nfp
$ useWithStale GetParsedModuleWithComments nfp
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

and here

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Interestingly, this seems like somewhere we shouldn't do it. We really want the up-to-date module to compute an edit! But because we return the edit as part of the code lens, we have to. So the thing to do in the long run would be to implment codeLens/resolve so only the resolution method would need this. Worth a comment!

Also relevant for #3536

let exts = getExtensions pm
info = getNextPragmaInfo sessionDynFlags fileContents
pure [insertNewPragma info pragma | pragma `notElem` exts]
12 changes: 11 additions & 1 deletion plugins/hls-class-plugin/test/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,9 @@ classPlugin = mkPluginTestDescriptor Class.descriptor "class"
tests :: TestTree
tests = testGroup
"class"
[codeActionTests, codeLensTests]
[ codeActionTests
, codeLensTests
]

codeActionTests :: TestTree
codeActionTests = testGroup
Expand Down Expand Up @@ -101,6 +103,14 @@ codeLensTests = testGroup
goldenCodeLens "Don't insert pragma while GHC2021 enabled" "CodeLensWithGHC2021" 0
, goldenCodeLens "Qualified name" "Qualified" 0
, goldenCodeLens "Type family" "TypeFamily" 0
, testCase "keep stale lens" $ do
runSessionWithServer classPlugin testDataDir $ do
doc <- openDoc "Stale.hs" "haskell"
oldLens <- getCodeLenses doc
let edit = TextEdit (mkRange 4 11 4 12) "" -- Remove the `_`
_ <- applyEdit doc edit
newLens <- getCodeLenses doc
liftIO $ newLens @?= oldLens
]

_CACodeAction :: Prism' (Command |? CodeAction) CodeAction
Expand Down
5 changes: 5 additions & 0 deletions plugins/hls-class-plugin/test/testdata/Stale.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
module Stale where

data A a
instance Functor A where
fmap = _