Skip to content

Support for resolve for class-plugin lenses #3769

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.

Sign up for GitHub

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 8 commits into from
Sep 1, 2023
Merged

Support for resolve for class-plugin lenses #3769

Show file tree
Hide file tree
Changes from 3 commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
165f149
Initial support for resolve for class-plugin lenses
joyfulmantis Aug 21, 2023
bd36b70
WIP
joyfulmantis Aug 22, 2023
7b3e301
Merge branch 'master' into class-resolve
joyfulmantis Aug 23, 2023
86966dd
move the signature printing to as late as possible
joyfulmantis Aug 31, 2023
9cfabf8
merge upstream/master
joyfulmantis Aug 31, 2023
285df2e
Fix comment in Types.hs
joyfulmantis Aug 31, 2023
14584fd
Merge branch 'master' into class-resolve
joyfulmantis Aug 31, 2023
09d9b3c
Merge branch 'master' into class-resolve
joyfulmantis Sep 1, 2023
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
5 changes: 3 additions & 2 deletions plugins/hls-class-plugin/src/Ide/Plugin/Class.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,15 +10,16 @@ import Language.LSP.Protocol.Message
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor recorder plId = (defaultPluginDescriptor plId)
{ pluginCommands = commands plId
, pluginRules = rules recorder
, pluginRules = getInstanceBindTypeSigsRule recorder >> getInstanceBindLensRule recorder
, pluginHandlers = mkPluginHandler SMethod_TextDocumentCodeAction (codeAction recorder)
<> mkPluginHandler SMethod_TextDocumentCodeLens codeLens
<> mkResolveHandler SMethod_CodeLensResolve codeLensResolve
}

commands :: PluginId -> [PluginCommand IdeState]
commands plId
= [ PluginCommand codeActionCommandId
"add placeholders for minimal methods" (addMethodPlaceholders plId)
, PluginCommand typeLensCommandId
"add type signatures for instance methods" codeLensCommandHandler
"add type signatures for instance methods" (codeLensCommandHandler plId)
]
167 changes: 61 additions & 106 deletions plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,22 +1,22 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-overlapping-patterns #-}

module Ide.Plugin.Class.CodeLens where

import Control.Lens ((^.))
import Control.Lens ((&), (?~), (^.))
import Control.Monad.Trans.Class (MonadTrans (lift))
import Data.Aeson hiding (Null)
import qualified Data.IntMap.Strict as IntMap
import Data.Maybe (mapMaybe, maybeToList)
import qualified Data.Text as T
import Development.IDE
import Development.IDE.Core.PluginUtils
import Development.IDE.Core.PositionMapping
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Compat.Util
import Development.IDE.Spans.Pragmas (getFirstPragma,
insertNewPragma)
import Ide.Plugin.Class.Types
import Ide.Plugin.Class.Utils
import Ide.Plugin.Error
import Ide.PluginUtils
import Ide.Types
Expand All @@ -25,118 +25,73 @@ import Language.LSP.Protocol.Message
import Language.LSP.Protocol.Types
import Language.LSP.Server (sendRequest)

-- The code lens method is only responsible for providing the ranges of the code
-- lenses matched to a unique id
codeLens :: PluginMethodHandler IdeState Method_TextDocumentCodeLens
codeLens state plId CodeLensParams{..} = do
codeLens state _plId clp = do
nfp <- getNormalizedFilePathE $ clp ^. L.textDocument . L.uri
(InstanceBindLensResult (InstanceBindLens{lensRange}), pm)
<- runActionE "classplugin.GetInstanceBindLens" state
-- Using stale results means that we can almost always return a
-- value. In practice this means the lenses don't 'flicker'
$ useWithStaleE GetInstanceBindLens nfp
pure $ InL $ mapMaybe (toCodeLens pm) lensRange
where toCodeLens pm (range, int) =
let newRange = toCurrentRange pm range
in (\r -> CodeLens r Nothing (Just $ toJSON int)) <$> newRange

-- The code lens resolve method matches a title to each unique id
codeLensResolve:: ResolveFunction IdeState Int Method_CodeLensResolve
codeLensResolve state plId cl uri uniqueID = do
nfp <- getNormalizedFilePathE uri
(tmr, _) <- runActionE "classplugin.TypeCheck" state
-- Using stale results means that we can almost always return a value. In practice
-- this means the lenses don't 'flicker'
$ useWithStaleE TypeCheck nfp

-- All instance binds
(InstanceBindTypeSigsResult allBinds, mp) <- runActionE "classplugin.GetInstanceBindTypeSigs" state
-- Using stale results means that we can almost always return a value. In practice
-- this means the lenses don't 'flicker'
$ useWithStaleE GetInstanceBindTypeSigs nfp

pragmaInsertion <- insertPragmaIfNotPresent state nfp InstanceSigs

let (hsGroup, _, _, _) = tmrRenamed tmr
tycls = hs_tyclds hsGroup
-- declared instance methods without signatures
bindInfos = [ bind
| instds <- map group_instds tycls -- class instance decls
, instd <- instds
, inst <- maybeToList $ getClsInstD (unLoc instd)
, bind <- getBindSpanWithoutSig inst
]
targetSigs = matchBind bindInfos allBinds
makeLens (range, title) =
generateLens plId range title
$ workspaceEdit pragmaInsertion
$ makeEdit range title mp
codeLens = makeLens <$> mapMaybe getRangeWithSig targetSigs

pure $ InL codeLens
(InstanceBindLensResult (InstanceBindLens{lensRendered}), _)
Copy link
Collaborator

Choose a reason for hiding this comment

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

It looks like we are doing the same thing that codeLens did, do we really need this duplication?

Copy link
Collaborator Author

Choose a reason for hiding this comment

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

All three methods: the code lens, the code lens resolve, and the command handler rely on the same rule. However, we extract different data from the rule. For the first code lens handler, we only return the range of each code lens and a unique ID that allows us to resolve it later. To resolve the lens we match the unique ID the client sends us to the text edit of the lens (this allows us to extract the title). Finally, for the command, we actually generate a correct textEdit with position mapping properly adjusted and use that.

Copy link
Collaborator Author

Choose a reason for hiding this comment

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

I should add that, the code lens method tends to be called with every file update (a lot). The resolve method gets called for each visible lens. Finally, the command only gets called when someone wants to apply a lens (compared to the other two methods practically never)

Copy link
Collaborator

Choose a reason for hiding this comment

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

My point is about the action, we are calling the same classplugin.GetInstanceBindLens action for different functions, not sure if we can omit some calls, but overall this is good enough now.

<- runActionE "classplugin.GetInstanceBindLens" state
$ useWithStaleE GetInstanceBindLens nfp
resolveData <- handleMaybe PluginStaleResolve
$ IntMap.lookup uniqueID lensRendered
let makeCommand (TextEdit _ title) =
mkLspCommand plId typeLensCommandId title (Just [toJSON $ InstanceBindLensCommand uri uniqueID])
pure $ cl & L.command ?~ makeCommand resolveData

-- Finally the command actually generates and applies the workspace edit for the
-- specified unique id.
codeLensCommandHandler :: PluginId -> CommandFunction IdeState InstanceBindLensCommand
codeLensCommandHandler plId state InstanceBindLensCommand{commandUri, commandUid} = do
nfp <- getNormalizedFilePathE commandUri
(InstanceBindLensResult (InstanceBindLens{lensRendered, lensEnabledExtensions}), pm)
<- runActionE "classplugin.GetInstanceBindLens" state
$ useWithStaleE GetInstanceBindLens nfp
-- We are only interested in the pragma information if the user does not
-- have the InstanceSigs extension enabled
mbPragma <- if InstanceSigs `elem` lensEnabledExtensions
then pure Nothing
else Just <$> getFirstPragma plId state nfp
resolveData <- handleMaybe PluginStaleResolve
$ IntMap.lookup commandUid lensRendered
let -- By mapping over our Maybe NextPragmaInfo value, we only compute this
-- edit if we actually need to.
pragmaInsertion =
maybeToList $ flip insertNewPragma InstanceSigs <$> mbPragma
makeWEdit (TextEdit range title) =
workspaceEdit pragmaInsertion . pure <$> makeEdit range title pm
wEdit <- handleMaybe (PluginInvalidUserState "toCurrentRange")
$ makeWEdit resolveData
_ <- lift $ sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit) (\_ -> pure ())
pure $ InR Null
where
uri = _textDocument ^. L.uri

-- Match Binds with their signatures
-- We try to give every `InstanceBindTypeSig` a `SrcSpan`,
-- hence we can display signatures for `InstanceBindTypeSig` with span later.
matchBind :: [BindInfo] -> [InstanceBindTypeSig] -> [InstanceBindTypeSig]
matchBind existedBinds allBindWithSigs =
[foldl go bindSig existedBinds | bindSig <- allBindWithSigs]
where
-- | The `bindDefSpan` of the bind is `Nothing` before,
-- we update it with the span where binding occurs.
-- Hence, we can infer the place to display the signature later.
update :: InstanceBindTypeSig -> SrcSpan -> InstanceBindTypeSig
update bind sp = bind {bindDefSpan = Just sp}

go :: InstanceBindTypeSig -> BindInfo -> InstanceBindTypeSig
go bindSig bind = case (srcSpanToRange . bindNameSpan) bind of
Nothing -> bindSig
Just range ->
if inRange range (getSrcSpan $ bindName bindSig)
then update bindSig (bindSpan bind)
else bindSig

getClsInstD (ClsInstD _ d) = Just d
getClsInstD _ = Nothing

getSigName (ClassOpSig _ _ sigNames _) = Just $ map unLoc sigNames
getSigName _ = Nothing

getBindSpanWithoutSig :: ClsInstDecl GhcRn -> [BindInfo]
getBindSpanWithoutSig ClsInstDecl{..} =
let bindNames = mapMaybe go (bagToList cid_binds)
go (L l bind) = case bind of
FunBind{..}
-- `Generated` tagged for Template Haskell,
-- here we filter out nonsence generated bindings
-- that are nonsense for displaying code lenses.
--
-- See https://github.com/haskell/haskell-language-server/issues/3319
| not $ isGenerated (groupOrigin fun_matches)
-> Just $ L l fun_id
_ -> Nothing
-- Existed signatures' name
sigNames = concat $ mapMaybe (\(L _ r) -> getSigName r) cid_sigs
toBindInfo (L l (L l' _)) = BindInfo
(locA l) -- bindSpan
(locA l') -- bindNameSpan
in toBindInfo <$> filter (\(L _ name) -> unLoc name `notElem` sigNames) bindNames
getBindSpanWithoutSig _ = []

-- Get bind definition range with its rendered signature text
getRangeWithSig :: InstanceBindTypeSig -> Maybe (Range, T.Text)
getRangeWithSig bind = do
span <- bindDefSpan bind
range <- srcSpanToRange span
pure (range, bindRendered bind)

workspaceEdit pragmaInsertion edits =
WorkspaceEdit
(pure [(uri, edits ++ pragmaInsertion)])
(pure [(commandUri, edits ++ pragmaInsertion)])
Nothing
Nothing

generateLens :: PluginId -> Range -> T.Text -> WorkspaceEdit -> CodeLens
generateLens plId range title edit =
let cmd = mkLspCommand plId typeLensCommandId title (Just [toJSON edit])
in CodeLens range (Just cmd) Nothing

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


codeLensCommandHandler :: CommandFunction IdeState WorkspaceEdit
codeLensCommandHandler _ wedit = do
_ <- lift $ sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) (\_ -> pure ())
pure $ InR Null
Loading