Provide code action in hls-eval-plugin

jian-lin · fendor · commit caa1c32f4b45 · 2025-04-17T17:58:36.000+02:00
Code action and lens are provided at the same time. In addition, a file is excluded from stylish-haskell pre-commit hook due to a CPP issue introduced in #4527. Fix: #496
diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml
@@ -4,7 +4,7 @@ repos:
   - hooks:
       - entry: stylish-haskell --inplace
         exclude: >-
-          (^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$)
+          (^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/Handlers.hs$)
         files: \.l?hs$
         id: stylish-haskell
         language: system
diff --git a/docs/features.md b/docs/features.md
@@ -346,7 +346,7 @@ Shows the type signature for bindings without type signatures, and adds it with
 
 Provided by: `hls-eval-plugin`
 
-Evaluates code blocks in comments with a click. [Tutorial](https://github.com/haskell/haskell-language-server/blob/master/plugins/hls-eval-plugin/README.md).
+Evaluates code blocks in comments with a click.  A code action is also provided. [Tutorial](https://github.com/haskell/haskell-language-server/blob/master/plugins/hls-eval-plugin/README.md).
 
 ![Eval Demo](../plugins/hls-eval-plugin/demo.gif)
 
diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal
@@ -460,9 +460,9 @@ library hls-eval-plugin
   hs-source-dirs:     plugins/hls-eval-plugin/src
   other-modules:
     Ide.Plugin.Eval.Code
-    Ide.Plugin.Eval.CodeLens
     Ide.Plugin.Eval.Config
     Ide.Plugin.Eval.GHC
+    Ide.Plugin.Eval.Handlers
     Ide.Plugin.Eval.Parse.Comments
     Ide.Plugin.Eval.Parse.Option
     Ide.Plugin.Eval.Rules
diff --git a/plugins/hls-eval-plugin/README.md b/plugins/hls-eval-plugin/README.md
@@ -40,7 +40,7 @@ A test is composed by a sequence of contiguous lines, the result of their evalua
 "CDAB"
 ```
 
-You execute a test by clicking on the _Evaluate_ code lens that appears above it (or _Refresh_, if the test has been run previously).
+You execute a test by clicking on the _Evaluate_ code lens that appears above it (or _Refresh_, if the test has been run previously). A code action is also provided.
 
 All tests in the same comment block are executed together.
 
diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval.hs
@@ -13,8 +13,8 @@ module Ide.Plugin.Eval (
 
 import           Development.IDE               (IdeState)
 import           Ide.Logger                    (Recorder, WithPriority)
-import qualified Ide.Plugin.Eval.CodeLens      as CL
 import           Ide.Plugin.Eval.Config
+import qualified Ide.Plugin.Eval.Handlers      as Handlers
 import           Ide.Plugin.Eval.Rules         (rules)
 import qualified Ide.Plugin.Eval.Types         as Eval
 import           Ide.Types                     (ConfigDescriptor (..),
@@ -27,9 +27,12 @@ import           Language.LSP.Protocol.Message
 -- |Plugin descriptor
 descriptor :: Recorder (WithPriority Eval.Log) -> PluginId -> PluginDescriptor IdeState
 descriptor recorder plId =
-    (defaultPluginDescriptor plId "Provies a code lens to evaluate expressions in doctest comments")
-        { pluginHandlers = mkPluginHandler SMethod_TextDocumentCodeLens (CL.codeLens recorder)
-        , pluginCommands = [CL.evalCommand recorder plId]
+    (defaultPluginDescriptor plId "Provies code action and lens to evaluate expressions in doctest comments")
+        { pluginHandlers = mconcat
+            [ mkPluginHandler SMethod_TextDocumentCodeAction (Handlers.codeAction recorder)
+            , mkPluginHandler SMethod_TextDocumentCodeLens (Handlers.codeLens recorder)
+            ]
+        , pluginCommands = [Handlers.evalCommand recorder plId]
         , pluginRules = rules recorder
         , pluginConfigDescriptor = defaultConfigDescriptor
                                    { configCustomConfig = mkCustomConfig properties
diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs
@@ -12,7 +12,8 @@ A plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>
 
 For a full example see the "Ide.Plugin.Eval.Tutorial" module.
 -}
-module Ide.Plugin.Eval.CodeLens (
+module Ide.Plugin.Eval.Handlers (
+    codeAction,
     codeLens,
     evalCommand,
 ) where
@@ -125,17 +126,35 @@ import           Language.LSP.Server
 import           GHC.Unit.Module.ModIface                     (IfaceTopEnv (..))
 #endif
 
+codeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction
+codeAction recorder st plId CodeActionParams{_textDocument,_range} = do
+    rangeCommands <- mkRangeCommands recorder st plId _textDocument
+    pure
+        $ InL
+            [ InL command
+            | (testRange, command) <- rangeCommands
+            , _range `isSubrangeOf` testRange
+            ]
 
 {- | Code Lens provider
  NOTE: Invoked every time the document is modified, not just when the document is saved.
 -}
 codeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens
-codeLens recorder st plId CodeLensParams{_textDocument} =
+codeLens recorder st plId CodeLensParams{_textDocument} = do
+    rangeCommands <- mkRangeCommands recorder st plId _textDocument
+    pure
+        $ InL
+            [ CodeLens range (Just command) Nothing
+            | (range, command) <- rangeCommands
+            ]
+
+mkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]
+mkRangeCommands recorder st plId textDocument =
     let dbg = logWith recorder Debug
         perf = timed (\lbl duration -> dbg $ LogExecutionTime lbl duration)
-     in perf "codeLens" $
+     in perf "evalMkRangeCommands" $
             do
-                let TextDocumentIdentifier uri = _textDocument
+                let TextDocumentIdentifier uri = textDocument
                 fp <- uriToFilePathE uri
                 let nfp = toNormalizedFilePath' fp
                     isLHS = isLiterate fp
@@ -148,11 +167,11 @@ codeLens recorder st plId CodeLensParams{_textDocument} =
                 let Sections{..} = commentsToSections isLHS comments
                     tests = testsBySection nonSetupSections
                     cmd = mkLspCommand plId evalCommandName "Evaluate=..." (Just [])
-                let lenses =
-                        [ CodeLens testRange (Just cmd') Nothing
+                let rangeCommands =
+                        [ (testRange, cmd')
                         | (section, ident, test) <- tests
                         , let (testRange, resultRange) = testRanges test
-                              args = EvalParams (setupSections ++ [section]) _textDocument ident
+                              args = EvalParams (setupSections ++ [section]) textDocument ident
                               cmd' =
                                 (cmd :: Command)
                                     { _arguments = Just [toJSON args]
@@ -168,9 +187,9 @@ codeLens recorder st plId CodeLensParams{_textDocument} =
                             (length tests)
                             (length nonSetupSections)
                             (length setupSections)
-                            (length lenses)
+                            (length rangeCommands)
 
-                return $ InL lenses
+                pure rangeCommands
   where
     trivial (Range p p') = p == p'
 
diff --git a/plugins/hls-eval-plugin/test/Main.hs b/plugins/hls-eval-plugin/test/Main.hs
@@ -6,13 +6,15 @@ module Main
   ) where
 
 import           Control.Lens               (_Just, folded, preview, view, (^.),
-                                             (^..))
+                                             (^..), (^?))
+import           Control.Monad              (join)
 import           Data.Aeson                 (Value (Object), fromJSON, object,
                                              (.=))
 import           Data.Aeson.Types           (Pair, Result (Success))
 import           Data.List                  (isInfixOf)
 import           Data.List.Extra            (nubOrdOn)
 import qualified Data.Map                   as Map
+import qualified Data.Maybe                 as Maybe
 import qualified Data.Text                  as T
 import           Ide.Plugin.Config          (Config)
 import qualified Ide.Plugin.Config          as Plugin
@@ -59,6 +61,9 @@ tests =
         lenses <- getCodeLenses doc
         liftIO $ map (view range) lenses @?= [Range (Position 4 0) (Position 5 0)]
 
+  , goldenWithEvalForCodeAction "Evaluation of expressions via code action" "T1" "hs"
+  , goldenWithEvalForCodeAction "Reevaluation of expressions via code action" "T2" "hs"
+
   , goldenWithEval "Evaluation of expressions" "T1" "hs"
   , goldenWithEval "Reevaluation of expressions" "T2" "hs"
   , goldenWithEval "Evaluation of expressions w/ imports" "T3" "hs"
@@ -221,6 +226,10 @@ goldenWithEval :: TestName -> FilePath -> FilePath -> TestTree
 goldenWithEval title path ext =
   goldenWithHaskellDocInTmpDir def evalPlugin title (mkFs $ FS.directProject (path <.> ext)) path "expected" ext executeLensesBackwards
 
+goldenWithEvalForCodeAction :: TestName -> FilePath -> FilePath -> TestTree
+goldenWithEvalForCodeAction title path ext =
+  goldenWithHaskellDocInTmpDir def evalPlugin title (mkFs $ FS.directProject (path <.> ext)) path "expected" ext executeCodeActionsBackwards
+
 goldenWithEvalAndFs :: TestName -> [FS.FileTree] -> FilePath -> FilePath -> TestTree
 goldenWithEvalAndFs title tree path ext =
   goldenWithHaskellDocInTmpDir def evalPlugin title (mkFs tree) path  "expected" ext executeLensesBackwards
@@ -239,14 +248,24 @@ goldenWithEvalAndFs' title tree path ext expected =
 -- | Execute lenses backwards, to avoid affecting their position in the source file
 executeLensesBackwards :: TextDocumentIdentifier -> Session ()
 executeLensesBackwards doc = do
-  codeLenses <- reverse <$> getCodeLenses doc
+  codeLenses <- getCodeLenses doc
   -- liftIO $ print codeLenses
+  executeCmdsBackwards [c | CodeLens{_command = Just c} <- codeLenses]
+
+executeCodeActionsBackwards :: TextDocumentIdentifier -> Session ()
+executeCodeActionsBackwards doc = do
+  codeLenses <- getCodeLenses doc
+  let ranges = [_range | CodeLens{_range} <- codeLenses]
+  -- getAllCodeActions cannot get our code actions because they have no diagnostics
+  codeActions <- join <$> traverse (getCodeActions doc) ranges
+  let cmds = Maybe.mapMaybe (^? _L) codeActions
+  executeCmdsBackwards cmds
 
-  -- Execute sequentially, nubbing elements to avoid
-  -- evaluating the same section with multiple tests
-  -- more than twice
-  mapM_ executeCmd $
-    nubOrdOn actSectionId [c | CodeLens{_command = Just c} <- codeLenses]
+-- Execute commands backwards, nubbing elements to avoid
+-- evaluating the same section with multiple tests
+-- more than twice
+executeCmdsBackwards :: [Command] -> Session ()
+executeCmdsBackwards = mapM_ executeCmd . nubOrdOn actSectionId . reverse
 
 actSectionId :: Command -> Int
 actSectionId Command{_arguments = Just [fromJSON -> Success EvalParams{..}]} = evalId
diff --git a/test/testdata/schema/ghc912/default-config.golden.json b/test/testdata/schema/ghc912/default-config.golden.json
@@ -39,11 +39,12 @@
             "codeLensOn": true
         },
         "eval": {
+            "codeActionsOn": true,
+            "codeLensOn": true,
             "config": {
                 "diff": true,
                 "exception": false
-            },
-            "globalOn": true
+            }
         },
         "explicit-fields": {
             "codeActionsOn": true,
diff --git a/test/testdata/schema/ghc912/vscode-extension-schema.golden.json b/test/testdata/schema/ghc912/vscode-extension-schema.golden.json
@@ -77,6 +77,18 @@
         "scope": "resource",
         "type": "boolean"
     },
+    "haskell.plugin.eval.codeActionsOn": {
+        "default": true,
+        "description": "Enables eval code actions",
+        "scope": "resource",
+        "type": "boolean"
+    },
+    "haskell.plugin.eval.codeLensOn": {
+        "default": true,
+        "description": "Enables eval code lenses",
+        "scope": "resource",
+        "type": "boolean"
+    },
     "haskell.plugin.eval.config.diff": {
         "default": true,
         "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses",
@@ -89,12 +101,6 @@
         "scope": "resource",
         "type": "boolean"
     },
-    "haskell.plugin.eval.globalOn": {
-        "default": true,
-        "description": "Enables eval plugin",
-        "scope": "resource",
-        "type": "boolean"
-    },
     "haskell.plugin.explicit-fields.codeActionsOn": {
         "default": true,
         "description": "Enables explicit-fields code actions",
diff --git a/test/testdata/schema/ghc94/default-config.golden.json b/test/testdata/schema/ghc94/default-config.golden.json
@@ -39,11 +39,12 @@
             "codeLensOn": true
         },
         "eval": {
+            "codeActionsOn": true,
+            "codeLensOn": true,
             "config": {
                 "diff": true,
                 "exception": false
-            },
-            "globalOn": true
+            }
         },
         "explicit-fields": {
             "codeActionsOn": true,
diff --git a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json
@@ -77,6 +77,18 @@
         "scope": "resource",
         "type": "boolean"
     },
+    "haskell.plugin.eval.codeActionsOn": {
+        "default": true,
+        "description": "Enables eval code actions",
+        "scope": "resource",
+        "type": "boolean"
+    },
+    "haskell.plugin.eval.codeLensOn": {
+        "default": true,
+        "description": "Enables eval code lenses",
+        "scope": "resource",
+        "type": "boolean"
+    },
     "haskell.plugin.eval.config.diff": {
         "default": true,
         "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses",
@@ -89,12 +101,6 @@
         "scope": "resource",
         "type": "boolean"
     },
-    "haskell.plugin.eval.globalOn": {
-        "default": true,
-        "description": "Enables eval plugin",
-        "scope": "resource",
-        "type": "boolean"
-    },
     "haskell.plugin.explicit-fields.codeActionsOn": {
         "default": true,
         "description": "Enables explicit-fields code actions",
diff --git a/test/testdata/schema/ghc96/default-config.golden.json b/test/testdata/schema/ghc96/default-config.golden.json
@@ -39,11 +39,12 @@
             "codeLensOn": true
         },
         "eval": {
+            "codeActionsOn": true,
+            "codeLensOn": true,
             "config": {
                 "diff": true,
                 "exception": false
-            },
-            "globalOn": true
+            }
         },
         "explicit-fields": {
             "codeActionsOn": true,
diff --git a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json
@@ -77,6 +77,18 @@
         "scope": "resource",
         "type": "boolean"
     },
+    "haskell.plugin.eval.codeActionsOn": {
+        "default": true,
+        "description": "Enables eval code actions",
+        "scope": "resource",
+        "type": "boolean"
+    },
+    "haskell.plugin.eval.codeLensOn": {
+        "default": true,
+        "description": "Enables eval code lenses",
+        "scope": "resource",
+        "type": "boolean"
+    },
     "haskell.plugin.eval.config.diff": {
         "default": true,
         "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses",
@@ -89,12 +101,6 @@
         "scope": "resource",
         "type": "boolean"
     },
-    "haskell.plugin.eval.globalOn": {
-        "default": true,
-        "description": "Enables eval plugin",
-        "scope": "resource",
-        "type": "boolean"
-    },
     "haskell.plugin.explicit-fields.codeActionsOn": {
         "default": true,
         "description": "Enables explicit-fields code actions",
diff --git a/test/testdata/schema/ghc98/default-config.golden.json b/test/testdata/schema/ghc98/default-config.golden.json
@@ -39,11 +39,12 @@
             "codeLensOn": true
         },
         "eval": {
+            "codeActionsOn": true,
+            "codeLensOn": true,
             "config": {
                 "diff": true,
                 "exception": false
-            },
-            "globalOn": true
+            }
         },
         "explicit-fields": {
             "codeActionsOn": true,
diff --git a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json
@@ -77,6 +77,18 @@
         "scope": "resource",
         "type": "boolean"
     },
+    "haskell.plugin.eval.codeActionsOn": {
+        "default": true,
+        "description": "Enables eval code actions",
+        "scope": "resource",
+        "type": "boolean"
+    },
+    "haskell.plugin.eval.codeLensOn": {
+        "default": true,
+        "description": "Enables eval code lenses",
+        "scope": "resource",
+        "type": "boolean"
+    },
     "haskell.plugin.eval.config.diff": {
         "default": true,
         "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses",
@@ -89,12 +101,6 @@
         "scope": "resource",
         "type": "boolean"
     },
-    "haskell.plugin.eval.globalOn": {
-        "default": true,
-        "description": "Enables eval plugin",
-        "scope": "resource",
-        "type": "boolean"
-    },
     "haskell.plugin.explicit-fields.codeActionsOn": {
         "default": true,
         "description": "Enables explicit-fields code actions",
