Make code-lens for toplevel let binding configurable

CHANGES.md

@@ -1,3 +1,9 @@
+# Unreleased
+
+## Fixes
+
+- Make `code-lens` for toplevel let binding configurable (#1567)
+
 # 1.24.0
 
 ## Features

ocaml-lsp-server/docs/ocamllsp/config.md

@@ -15,12 +15,21 @@ interface config {
   */
   extendedHover: { enable : boolean }
 
-  /**
-  * Enable/Disable CodeLens
-  * @default false
-  * @since 1.16
-  */
-  codelens: { enable : boolean }
+  codelens: {
+    /**
+    * Enable/Disable CodeLens
+    * @default false
+    * @since 1.16
+    */
+    enable : boolean,
+
+    /**
+    * Enable CodeLens only for toplevel let binding
+    * @default false
+    * @since 1.24
+    */
+    only_toplevel
+  }
 
   /**
   * Enable/Disable Dune diagnostics

ocaml-lsp-server/src/config_data.ml

@@ -192,7 +192,10 @@ module InlayHints = struct
 end
 
 module Lens = struct
-  type t = { enable : bool [@default true] }
+  type t =
+    { enable : bool [@default true]
+    ; only_toplevel : bool [@default false]
+    }
   [@@deriving_inline yojson] [@@yojson.allow_extra_fields]
 
   let _ = fun (_ : t) -> ()
@@ -202,6 +205,7 @@ module Lens = struct
      function
      | `Assoc field_yojsons as yojson ->
        let enable_field = ref Ppx_yojson_conv_lib.Option.None
+       and only_toplevel_field = ref Ppx_yojson_conv_lib.Option.None
        and duplicates = ref []
        and extra = ref [] in
        let rec iter = function
@@ -214,6 +218,13 @@ module Lens = struct
                  enable_field := Ppx_yojson_conv_lib.Option.Some fvalue
                | Ppx_yojson_conv_lib.Option.Some _ ->
                  duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates)
+            | "only_toplevel" ->
+              (match Ppx_yojson_conv_lib.( ! ) only_toplevel_field with
+               | Ppx_yojson_conv_lib.Option.None ->
+                 let fvalue = bool_of_yojson _field_yojson in
+                 only_toplevel_field := Ppx_yojson_conv_lib.Option.Some fvalue
+               | Ppx_yojson_conv_lib.Option.Some _ ->
+                 duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates)
             | _ -> ());
            iter tail
          | [] -> ()
@@ -233,11 +244,18 @@ module Lens = struct
                (Ppx_yojson_conv_lib.( ! ) extra)
                yojson
            | [] ->
-             let enable_value = Ppx_yojson_conv_lib.( ! ) enable_field in
+             let enable_value, only_toplevel_value =
+               ( Ppx_yojson_conv_lib.( ! ) enable_field
+               , Ppx_yojson_conv_lib.( ! ) only_toplevel_field )
+             in
              { enable =
                  (match enable_value with
                   | Ppx_yojson_conv_lib.Option.None -> true
                   | Ppx_yojson_conv_lib.Option.Some v -> v)
+             ; only_toplevel =
+                 (match only_toplevel_value with
+                  | Ppx_yojson_conv_lib.Option.None -> false
+                  | Ppx_yojson_conv_lib.Option.Some v -> v)
              }))
      | _ as yojson ->
        Ppx_yojson_conv_lib.Yojson_conv_error.record_list_instead_atom _tp_loc yojson
@@ -248,8 +266,12 @@ module Lens = struct
 
   let yojson_of_t =
     (function
-     | { enable = v_enable } ->
+     | { enable = v_enable; only_toplevel = v_only_toplevel } ->
        let bnds : (string * Ppx_yojson_conv_lib.Yojson.Safe.t) list = [] in
+       let bnds =
+         let arg = yojson_of_bool v_only_toplevel in
+         ("only_toplevel", arg) :: bnds
+       in
        let bnds =
          let arg = yojson_of_bool v_enable in
          ("enable", arg) :: bnds
@@ -921,7 +943,7 @@ let _ = yojson_of_t
 [@@@end]
 
 let default =
-  { codelens = Some { enable = false }
+  { codelens = Some { enable = false; only_toplevel = true }
   ; extended_hover = Some { enable = false }
   ; standard_hover = Some { enable = true }
   ; inlay_hints =

ocaml-lsp-server/src/ocaml_lsp_server.ml

@@ -363,7 +363,11 @@ module Formatter = struct
   ;;
 end
 
-let text_document_lens (state : State.t) { CodeLensParams.textDocument = { uri }; _ } =
+let text_document_lens
+      (state : State.t)
+      { CodeLensParams.textDocument = { uri }; _ }
+      ~only_toplevel
+  =
   let store = state.store in
   let doc = Document_store.get store uri in
   match Document.kind doc with
@@ -372,7 +376,11 @@ let text_document_lens (state : State.t) { CodeLensParams.textDocument = { uri }
   | `Merlin doc ->
     let+ outline = Document.Merlin.dispatch_exn ~name:"outline" doc Outline in
     let rec symbol_info_of_outline_item (item : Query_protocol.item) =
-      let children = List.concat_map item.children ~f:symbol_info_of_outline_item in
+      let children =
+        if only_toplevel
+        then []
+        else List.concat_map item.children ~f:symbol_info_of_outline_item
+      in
       match item.outline_type with
       | None -> children
       | Some typ ->
@@ -651,7 +659,8 @@ let on_request
   | TextDocumentCodeLensResolve codeLens -> now codeLens
   | TextDocumentCodeLens req ->
     (match state.configuration.data.codelens with
-     | Some { enable = true } -> later text_document_lens req
+     | Some { enable = true; only_toplevel } ->
+       later (text_document_lens ~only_toplevel) req
      | _ -> now [])
   | TextDocumentHighlight req -> later highlight req
   | DocumentSymbol { textDocument = { uri }; _ } -> later document_symbol uri

ocaml-lsp-server/test/e2e-new/code_lens.ml

@@ -0,0 +1,101 @@
+open Test.Import
+
+let change_config client params = Client.notification client (ChangeConfiguration params)
+
+let codelens client textDocument =
+  Client.request
+    client
+    (TextDocumentCodeLens
+       { textDocument; workDoneToken = None; partialResultToken = None })
+;;
+
+let json_of_codelens cs = `List (List.map ~f:CodeLens.yojson_of_t cs)
+
+let%expect_test "enable only codelens for toplevel let binding 1" =
+  let source =
+    {ocaml|
+let toplevel = "Hello"
+
+let func x = x
+
+let f x =
+  let y = 10 in
+  let z = 3 in
+  x + y + z
+|ocaml}
+  in
+  let req client =
+    let text_document = TextDocumentIdentifier.create ~uri:Helpers.uri in
+    let* () =
+      change_config
+        client
+        (DidChangeConfigurationParams.create
+           ~settings:(`Assoc [ "codelens", `Assoc [ "only_toplevel", `Bool true ] ]))
+    in
+    let* resp_codelens_toplevel = codelens client text_document in
+    Test.print_result (json_of_codelens resp_codelens_toplevel);
+    Fiber.return ()
+  in
+  Helpers.test source req;
+  [%expect {|
+    [
+      {
+        "command": { "command": "", "title": "int -> int" },
+        "range": {
+          "end": { "character": 11, "line": 8 },
+          "start": { "character": 0, "line": 5 }
+        }
+      },
+      {
+        "command": { "command": "", "title": "'a -> 'a" },
+        "range": {
+          "end": { "character": 14, "line": 3 },
+          "start": { "character": 0, "line": 3 }
+        }
+      },
+      {
+        "command": { "command": "", "title": "string" },
+        "range": {
+          "end": { "character": 22, "line": 1 },
+          "start": { "character": 0, "line": 1 }
+        }
+      }
+    ]
+    |}]
+;;
+
+let%expect_test "enable only codelens for toplevel let binding 2" =
+  let source =
+    {ocaml|
+let x =
+  let y = 10 in
+  "Hello"
+
+let () = ()
+|ocaml}
+  in
+  let req client =
+    let text_document = TextDocumentIdentifier.create ~uri:Helpers.uri in
+    let* () =
+      change_config
+        client
+        (DidChangeConfigurationParams.create
+           ~settings:(`Assoc [ "codelens", `Assoc [ "only_toplevel", `Bool true ] ]))
+    in
+    let* resp_codelens_toplevel = codelens client text_document in
+    Test.print_result (json_of_codelens resp_codelens_toplevel);
+    Fiber.return ()
+  in
+  Helpers.test source req;
+  [%expect {|
+    [
+      {
+        "command": { "command": "", "title": "string" },
+        "range": {
+          "end": { "character": 9, "line": 3 },
+          "start": { "character": 0, "line": 1 }
+        }
+      }
+    ]
+    |}]
+;;

ocaml-lsp-server/test/e2e-new/dune

@@ -44,6 +44,7 @@
     action_inline
     action_mark_remove
     code_actions
+    code_lens
     completion
     completions
     construct