Skip to content

Commit ba290b0

Browse files
jian-linjian-lin
committed
Provide and prefer code action in hls-eval-plugin
Code lens is only used when the client does not support code action. In addition, a file is excluded from stylish-haskell pre-commit hook due to a CPP issue introduced in haskell#4527. Fix: haskell#496
1 parent 9127381 commit ba290b0

File tree

3 files changed

+46
-14
lines changed

3 files changed

+46
-14
lines changed

‎.pre-commit-config.yaml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ repos:
44
- hooks:
55
- entry: stylish-haskell --inplace
66
exclude: >-
7-
(^Setup.hs$|test/testdata/.*$|test/data/.*$|test/manual/lhs/.*$|^hie-compat/.*$|^plugins/hls-tactics-plugin/.*$|^ghcide/src/Development/IDE/GHC/Compat.hs$|^plugins/hls-refactor-plugin/src/Development/IDE/GHC/Compat/ExactPrint.hs$|^ghcide/src/Development/IDE/GHC/Compat/Core.hs$|^ghcide/src/Development/IDE/Spans/Pragmas.hs$|^ghcide/src/Development/IDE/LSP/Outline.hs$|^plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs$|^ghcide/src/Development/IDE/Core/Rules.hs$|^ghcide/src/Development/IDE/Core/Compile.hs$|^plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs$|^plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs$)
7+
(^Setup.hs$|test/testdata/.*$|test/data/.*$|test/manual/lhs/.*$|^hie-compat/.*$|^plugins/hls-tactics-plugin/.*$|^ghcide/src/Development/IDE/GHC/Compat.hs$|^plugins/hls-refactor-plugin/src/Development/IDE/GHC/Compat/ExactPrint.hs$|^ghcide/src/Development/IDE/GHC/Compat/Core.hs$|^ghcide/src/Development/IDE/Spans/Pragmas.hs$|^ghcide/src/Development/IDE/LSP/Outline.hs$|^plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs$|^ghcide/src/Development/IDE/Core/Rules.hs$|^ghcide/src/Development/IDE/Core/Compile.hs$|^plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs$|^plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs$|^plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs$)
88
files: \.l?hs$
99
id: stylish-haskell
1010
language: system

‎plugins/hls-eval-plugin/src/Ide/Plugin/Eval.hs‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -27,8 +27,11 @@ import Language.LSP.Protocol.Message
2727
-- |Plugin descriptor
2828
descriptor :: Recorder (WithPriority Eval.Log) -> PluginId -> PluginDescriptor IdeState
2929
descriptor recorder plId =
30-
(defaultPluginDescriptor plId "Provies a code lens to evaluate expressions in doctest comments")
31-
{ pluginHandlers = mkPluginHandler SMethod_TextDocumentCodeLens (CL.codeLens recorder)
30+
(defaultPluginDescriptor plId "Provies code action and lens to evaluate expressions in doctest comments")
31+
{ pluginHandlers = mconcat
32+
[ mkPluginHandler SMethod_TextDocumentCodeAction (CL.codeAction recorder)
33+
, mkPluginHandler SMethod_TextDocumentCodeLens (CL.codeLens recorder)
34+
]
3235
, pluginCommands = [CL.evalCommand recorder plId]
3336
, pluginRules = rules recorder
3437
, pluginConfigDescriptor = defaultConfigDescriptor

‎plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs‎

Lines changed: 40 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@ A plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>
1313
For a full example see the "Ide.Plugin.Eval.Tutorial" module.
1414
-}
1515
module Ide.Plugin.Eval.CodeLens (
16+
codeAction,
1617
codeLens,
1718
evalCommand,
1819
) where
@@ -21,7 +22,8 @@ import Control.Applicative (Alternative ((<|>
2122
import Control.Arrow (second)
2223
import Control.Exception (bracket_)
2324
import qualified Control.Exception as E
24-
import Control.Lens (ix, (%~), (^.))
25+
import Control.Lens (_Just, ix, (%~),
26+
(^.), (^?))
2527
import Control.Monad (guard, void,
2628
when)
2729
import Control.Monad.IO.Class (MonadIO (liftIO))
@@ -35,7 +37,8 @@ import Data.List (dropWhileEnd,
3537
intercalate,
3638
intersperse)
3739
import qualified Data.Map as Map
38-
import Data.Maybe (catMaybes)
40+
import Data.Maybe (catMaybes,
41+
isJust)
3942
import Data.String (IsString)
4043
import Data.Text (Text)
4144
import qualified Data.Text as T
@@ -46,7 +49,9 @@ import Development.IDE.Core.Rules (IdeState,
4649
import Development.IDE.Core.RuleTypes (LinkableResult (linkableHomeMod),
4750
TypeCheck (..),
4851
tmrTypechecked)
49-
import Development.IDE.Core.Shake (useNoFile_, use_,
52+
import Development.IDE.Core.Shake (clientCapabilities,
53+
shakeExtras,
54+
useNoFile_, use_,
5055
uses_)
5156
import Development.IDE.GHC.Compat hiding (typeKind,
5257
unitState)
@@ -125,17 +130,41 @@ import Language.LSP.Server
125130
import GHC.Unit.Module.ModIface (IfaceTopEnv (..))
126131
#endif
127132

133+
codeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction
134+
codeAction recorder st plId CodeActionParams{_textDocument,_range} = do
135+
rangeCommands <- mkRangeCommands recorder st plId _textDocument
136+
pure
137+
$ InL
138+
[ InL command
139+
| (testRange, command) <- rangeCommands
140+
, _range `isSubrangeOf` testRange
141+
]
128142

129143
{- | Code Lens provider
130144
NOTE: Invoked every time the document is modified, not just when the document is saved.
131145
-}
132146
codeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens
133-
codeLens recorder st plId CodeLensParams{_textDocument} =
147+
codeLens recorder st plId CodeLensParams{_textDocument} = do
148+
let isCodeActionSupported =
149+
isJust $ clientCapabilities (shakeExtras st) ^? L.textDocument . _Just . L.codeAction . _Just
150+
-- provide code lens only if the client does not support code action
151+
if isCodeActionSupported
152+
then pure $ InR Null
153+
else do
154+
rangeCommands <- mkRangeCommands recorder st plId _textDocument
155+
pure
156+
$ InL
157+
[ CodeLens range (Just command) Nothing
158+
| (range, command) <- rangeCommands
159+
]
160+
161+
mkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]
162+
mkRangeCommands recorder st plId textDocument =
134163
let dbg = logWith recorder Debug
135164
perf = timed (\lbl duration -> dbg $ LogExecutionTime lbl duration)
136-
in perf "codeLens" $
165+
in perf "evalMkRangeCommands" $
137166
do
138-
let TextDocumentIdentifier uri = _textDocument
167+
let TextDocumentIdentifier uri = textDocument
139168
fp <- uriToFilePathE uri
140169
let nfp = toNormalizedFilePath' fp
141170
isLHS = isLiterate fp
@@ -148,11 +177,11 @@ codeLens recorder st plId CodeLensParams{_textDocument} =
148177
let Sections{..} = commentsToSections isLHS comments
149178
tests = testsBySection nonSetupSections
150179
cmd = mkLspCommand plId evalCommandName "Evaluate=..." (Just [])
151-
let lenses =
152-
[ CodeLens testRange (Just cmd') Nothing
180+
let rangeCommands =
181+
[ (testRange, cmd')
153182
| (section, ident, test) <- tests
154183
, let (testRange, resultRange) = testRanges test
155-
args = EvalParams (setupSections ++ [section]) _textDocument ident
184+
args = EvalParams (setupSections ++ [section]) textDocument ident
156185
cmd' =
157186
(cmd :: Command)
158187
{ _arguments = Just [toJSON args]
@@ -168,9 +197,9 @@ codeLens recorder st plId CodeLensParams{_textDocument} =
168197
(length tests)
169198
(length nonSetupSections)
170199
(length setupSections)
171-
(length lenses)
200+
(length rangeCommands)
172201

173-
return $ InL lenses
202+
pure rangeCommands
174203
where
175204
trivial (Range p p') = p == p'
176205

0 commit comments

Comments
 (0)