Add a setting to enable CodeLens only for toplevel let binding.

Author: Tim-ats-d

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,28 +363,43 @@ 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
   | `Other -> Fiber.return []
   | `Merlin m when Document.Merlin.kind m = Intf -> Fiber.return []
   | `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
-      match item.outline_type with
-      | None -> children
-      | Some typ ->
-        let loc = item.location in
-        let info =
+    if only_toplevel
+    then
+      List.filter_map outline ~f:(fun item ->
+        match item.outline_type with
+        | None -> None
+        | Some typ ->
+          let loc = item.location in
           let range = Range.of_loc loc in
           let command = Command.create ~title:typ ~command:"" () in
-          CodeLens.create ~range ~command ()
-        in
-        info :: children
-    in
-    List.concat_map ~f:symbol_info_of_outline_item outline
+          Some (CodeLens.create ~range ~command ()))
+    else (
+      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
+        match item.outline_type with
+        | None -> children
+        | Some typ ->
+          let loc = item.location in
+          let info =
+            let range = Range.of_loc loc in
+            let command = Command.create ~title:typ ~command:"" () in
+            CodeLens.create ~range ~command ()
+          in
+          info :: children
+      in
+      List.concat_map ~f:symbol_info_of_outline_item outline)
 ;;
 
 let selection_range
@@ -651,7 +666,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