_

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

ocaml-lsp-server/src/code_actions/action_update_signature.ml

@@ -6,7 +6,7 @@ let action_kind = "update_intf"
 let code_action_of_intf doc text_edits =
   let edit : WorkspaceEdit.t =
     let doc_edit =
-      let edits = (List.map text_edits ~f:(fun e -> `TextEdit e)) in
+      let edits = List.map text_edits ~f:(fun e -> `TextEdit e) in
       let textDocument =
         let uri = Document.uri doc in
         let version = Document.version doc in
@@ -16,7 +16,9 @@ let code_action_of_intf doc text_edits =
     in
     WorkspaceEdit.create ~documentChanges:[ `TextDocumentEdit doc_edit ] ()
   in
-  let title = String.capitalize_ascii "update signature(s) to match implementation" in
+  let title =
+    String.capitalize_ascii "update signature(s) to match implementation"
+  in
   CodeAction.create
     ~title
     ~kind:(CodeActionKind.Other action_kind)
@@ -34,8 +36,7 @@ let code_action (state : State.t) doc (params : CodeActionParams.t) =
     in
     match text_edits with
     | [] -> Fiber.return None
-    | _ ->
-      Fiber.return (Some (code_action_of_intf doc text_edits)))
+    | _ -> Fiber.return (Some (code_action_of_intf doc text_edits)))
 
 let kind = CodeActionKind.Other action_kind
 

ocaml-lsp-server/src/dune

@@ -40,7 +40,6 @@
  (lint
   (pps ppx_yojson_conv))
  (instrumentation
-  (backend bisect_ppx))
- (preprocess (pps ppx_let)))
+  (backend bisect_ppx)))
 
 (include_subdirs unqualified)

ocaml-lsp-server/src/import.ml

@@ -21,7 +21,15 @@ include struct
   module Fdecl = Fdecl
   module Fpath = Path
   module Int = Int
-  module List = List
+
+  module List = struct
+    include List
+
+    let findi xs ~f = Base.List.findi xs ~f
+
+    let sub xs ~pos ~len = Base.List.sub xs ~pos ~len
+  end
+
   module Map = Map
   module Monoid = Monoid
   module Option = Option

ocaml-lsp-server/src/inference.ml

@@ -4,21 +4,20 @@ module Printtyp = Merlin_analysis.Type_utils.Printtyp
 
 let get_typer doc =
   Document.Merlin.with_pipeline_exn ~name:"infer interface" doc (fun pipeline ->
-    Mpipeline.typer_result pipeline)
-;;
+      Mpipeline.typer_result pipeline)
 
 let get_doc_signature typer =
   let typedtree = Mtyper.get_typedtree typer in
   match typedtree with
   | `Interface intf -> intf.sig_type
   | `Implementation impl -> impl.str_type
-;;
 
 (** Called by the code action for insert-interface. *)
 let infer_missing_intf_for_impl impl_doc intf_doc =
-  match Document.kind impl_doc, Document.kind intf_doc with
+  match (Document.kind impl_doc, Document.kind intf_doc) with
   | `Merlin impl, `Merlin intf
-    when Document.Merlin.kind impl = Impl && Document.Merlin.kind intf = Intf ->
+    when Document.Merlin.kind impl = Impl && Document.Merlin.kind intf = Intf
+    -> (
     let drop_existing_ids full_sig cur_sig =
       let existing_ids = List.map cur_sig ~f:Types.signature_item_id in
       List.filter
@@ -28,20 +27,19 @@ let infer_missing_intf_for_impl impl_doc intf_doc =
         full_sig
     in
     let* typers = Fiber.parallel_map ~f:get_typer [ impl; intf ] in
-    (match typers with
-     | [ impl_typer; intf_typer ] ->
-       let full_sig = get_doc_signature impl_typer in
-       let cur_sig = get_doc_signature intf_typer in
-       let sig_update = drop_existing_ids full_sig cur_sig in
-       let env = Mtyper.initial_env impl_typer in
-       let* intf_cfg = Document.Merlin.mconfig intf in
-       let verbosity = intf_cfg.query.verbosity in
-       Printtyp.wrap_printing_env ~verbosity env (fun () ->
-         Format.asprintf "%a@." Printtyp.signature sig_update)
-       |> Fiber.return
-     | _ -> Code_error.raise "promblem encountered with Merlin typer_result" [])
+    match typers with
+    | [ impl_typer; intf_typer ] ->
+      let full_sig = get_doc_signature impl_typer in
+      let cur_sig = get_doc_signature intf_typer in
+      let sig_update = drop_existing_ids full_sig cur_sig in
+      let env = Mtyper.initial_env impl_typer in
+      let* intf_cfg = Document.Merlin.mconfig intf in
+      let verbosity = intf_cfg.query.verbosity in
+      Printtyp.wrap_printing_env ~verbosity env (fun () ->
+          Format.asprintf "%a@." Printtyp.signature sig_update)
+      |> Fiber.return
+    | _ -> Code_error.raise "promblem encountered with Merlin typer_result" [])
   | _ -> Code_error.raise "expected implementation and interface documents" []
-;;
 
 (* No longer involved in the insert-interface code action, but still used by the
    [ocamllsp/inferIntf] custom request. *)
@@ -131,10 +129,9 @@ let infer_intf (state : State.t) intf_doc =
         | Some impl_doc ->
           let+ res = infer_missing_intf_for_impl impl_doc intf_doc in
           Some res)
-;;
 
-(** Extracts an [Ident.t] from all variants that have one at the top level.
-    For many of the other variants, it would be possible to extract a list of IDs,
+(** Extracts an [Ident.t] from all variants that have one at the top level. For
+    many of the other variants, it would be possible to extract a list of IDs,
     but that's not needed for the update-signatures code action. *)
 let top_level_id (item : Typedtree.signature_item) =
   match item.sig_desc with
@@ -153,141 +150,152 @@ let top_level_id (item : Typedtree.signature_item) =
   | Typedtree.Tsig_class _
   | Typedtree.Tsig_class_type _
   | Typedtree.Tsig_attribute _ -> None
-;;
 
-(** Represents an item that's present in the existing interface and has a (possibly
-    differing) signature inferred from the implementation. *)
+(** Represents an item that's present in the existing interface and has a
+    (possibly differing) signature inferred from the implementation. *)
 type shared_signature =
   { range : Range.t (* location in the interface *)
   ; old_sig : Types.signature_item (* found in the interface *)
   ; new_sig : Types.signature_item (* inferred from the implementation *)
   }
 
-(** Try to make a [shared_signature], if an ID can be extracted from the [tree_item] and
-    a matching ID can be found in both signature lists. *)
+(** Try to make a [shared_signature], if an ID can be extracted from the
+    [tree_item] and a matching ID can be found in both signature lists. *)
 let find_shared_signature tree_item ~old_sigs ~new_sigs =
   let module List = Base.List in
-  let open Base.Option.Let_syntax in
-  let%bind id = top_level_id tree_item in
+  let open Option.O in
+  let* id = top_level_id tree_item in
   let id_equal sig_item = Ident.equal id (Types.signature_item_id sig_item) in
-  let%bind old_sig = List.find ~f:id_equal old_sigs in
-  let%bind new_sig = List.find ~f:id_equal new_sigs in
+  let* old_sig = List.find ~f:id_equal old_sigs in
+  let* new_sig = List.find ~f:id_equal new_sigs in
   let range = Range.of_loc tree_item.sig_loc in
   Some { range; old_sig; new_sig }
-;;
 
-(** Slices out the signatures between [first] and [last] to speed up future searches.
-    This assumes that [first] and [last] came from the [sig_items] field on a
-    [Typedtree.signature], and [sig_type_list] is the [sig_type] field on the same
-    [Typedtree.signature], meaning that the lists will be in the same order. *)
+(** Slices out the signatures between [first] and [last] to speed up future
+    searches. This assumes that [first] and [last] came from the [sig_items]
+    field on a [Typedtree.signature], and [sig_type_list] is the [sig_type]
+    field on the same [Typedtree.signature], meaning that the lists will be in
+    the same order. *)
 let select_matching_range ~first ~last sig_type_list =
-  let module List = Base.List in
-  let open Base.Option.Let_syntax in
   let index_of item =
-    let%bind item = item in
-    let%bind id = top_level_id item in
-    let%bind (i, _) =
+    let open Option.O in
+    let* item in
+    let* id = top_level_id item in
+    let* i, _ =
       List.findi sig_type_list ~f:(fun _ item ->
-        Ident.equal id (Types.signature_item_id item))
+          Ident.equal id (Types.signature_item_id item))
     in
     Some i
   in
   let start_index = index_of first |> Option.value ~default:0 in
-  let end_index = index_of last |> Option.value ~default:(List.length sig_type_list - 1) in
+  let end_index =
+    index_of last |> Option.value ~default:(List.length sig_type_list - 1)
+  in
   List.sub sig_type_list ~pos:start_index ~len:(end_index + 1 - start_index)
-;;
 
-(** Formats both the old and new signatures as they would appear in the interface.
-    If they differ, create a text edit that updates to the new signature. *)
+(** Formats both the old and new signatures as they would appear in the
+    interface. If they differ, create a text edit that updates to the new
+    signature. *)
 let text_edit_opt shared_signature ~formatter =
   (* CR-someday bwiedenbeck: We're relying on string equivalence of how the two signatures
-    are printed to decide if there's been an update. It'd be nice to check some sort of
-    logical equivalence on the actual types and then only format the ones that differ,
-    but that's not practical with the type information we have easy access to. *)
+     are printed to decide if there's been an update. It'd be nice to check some sort of
+     logical equivalence on the actual types and then only format the ones that differ,
+     but that's not practical with the type information we have easy access to. *)
   let+ sig_strings =
-    Fiber.parallel_map ~f:formatter [ shared_signature.old_sig; shared_signature.new_sig ]
+    Fiber.parallel_map
+      ~f:formatter
+      [ shared_signature.old_sig; shared_signature.new_sig ]
   in
   match sig_strings with
   | [ oldText; newText ] when not (String.equal oldText newText) ->
     Some ({ range = shared_signature.range; newText } : TextEdit.t)
   | _ -> None
-;;
 
-(** Produces text edits for every signature where the [formatter] produces a different
-    string on the [signature_item]s from the old interface and the new implementation. *)
-let build_signature_edits
-  ~(old_intf : Typedtree.signature) (* Extracted by Merlin from the interface. *)
-  ~(range : Range.t) (* Selected range in the interface. *)
-  ~(new_sigs : Types.signature) (* Inferred by Merlin from the implementation. *)
-  ~(formatter : Types.signature_item -> string Fiber.t)
-  =
+(** Produces text edits for every signature where the [formatter] produces a
+    different string on the [signature_item]s from the old interface and the new
+    implementation. *)
+let build_signature_edits ~(old_intf : Typedtree.signature)
+    ~(* Extracted by Merlin from the interface. *)
+    (range : Range.t)
+    ~(* Selected range in the interface. *)
+    (new_sigs : Types.signature)
+    ~(* Inferred by Merlin from the implementation. *)
+    (formatter : Types.signature_item -> string Fiber.t) =
   let module List = Base.List in
   (* These are [Typedtree.signature_item]s, and we need them for the location. *)
   let in_range_tree_items =
     List.filter old_intf.sig_items ~f:(fun si ->
-      Range.overlaps range (Range.of_loc si.sig_loc))
+        Range.overlaps range (Range.of_loc si.sig_loc))
   in
   let first = List.hd in_range_tree_items in
   let last = List.last in_range_tree_items in
   (* These are [Types.signature_item]s, and we need them to match up types. *)
-  let in_range_old_sigs = select_matching_range ~first ~last old_intf.sig_type in
+  let in_range_old_sigs =
+    select_matching_range ~first ~last old_intf.sig_type
+  in
   let in_range_new_sigs =
     (* This list can be big and we might search it many times when finding
        [shared_signatures], so it's worth doing a scan that shrinks it. *)
     List.filter new_sigs ~f:(fun si ->
-      let in_range_old_ids = List.map in_range_old_sigs ~f:Types.signature_item_id in
-      let id = Types.signature_item_id si in
-      List.mem in_range_old_ids id ~equal:Ident.equal)
+        let in_range_old_ids =
+          List.map in_range_old_sigs ~f:Types.signature_item_id
+        in
+        let id = Types.signature_item_id si in
+        List.mem in_range_old_ids id ~equal:Ident.equal)
   in
   let shared_signatures =
     List.filter_map
       in_range_tree_items
-      ~f:(find_shared_signature ~old_sigs:in_range_old_sigs ~new_sigs:in_range_new_sigs)
+      ~f:
+        (find_shared_signature
+           ~old_sigs:in_range_old_sigs
+           ~new_sigs:in_range_new_sigs)
+  in
+  let+ updates =
+    Fiber.parallel_map shared_signatures ~f:(text_edit_opt ~formatter)
   in
-  let+ updates = Fiber.parallel_map shared_signatures ~f:(text_edit_opt ~formatter) in
   List.filter_opt updates
-;;
 
 (** Called by the code action for update-signatures. *)
-let update_signatures
-  ~(state : State.t)
-  ~(intf_merlin : Document.Merlin.t)
-  ~(doc : Document.t)
-  ~(range : Range.t)
-  =
+let update_signatures ~(state : State.t) ~(intf_merlin : Document.Merlin.t)
+    ~(doc : Document.t) ~(range : Range.t) =
   Fiber.of_thunk (fun () ->
-    let intf_uri = Document.uri doc in
-    let impl_uri = Document.get_impl_intf_counterparts (Some intf_merlin) intf_uri |> List.hd in
-    let* impl_doc =
-      match Document_store.get_opt state.store impl_uri with
-      | Some impl -> Fiber.return (Some impl)
-      | None -> open_document_from_file state impl_uri
-    in
-    match impl_doc with
-    | None -> Fiber.return []
-    | Some impl_doc ->
-      let impl_merlin = Document.merlin_exn impl_doc in
-      (* CR-someday bwiedenbeck: These calls to Merlin to get the type information (and
-           the subsequent processing we do with it) are expensive on large documents.
-           This can cause problems if someone is trying to invoke some other code action,
-           because the LSP currently determines which CAs are possible by trying them all.
-           We've decided for now to allow slow code actions (especially since users are
-           less likely to be doing lots of little CAs in the mli file) and think more
-           about the broader CA protocol in the future. *)
-      let* typers = Fiber.parallel_map [ intf_merlin; impl_merlin ] ~f:get_typer in
-      let intf_typer = Base.List.hd_exn typers in
-      let impl_typer = Base.List.nth_exn typers 1 in
-      (match Mtyper.get_typedtree intf_typer with
-       | `Interface old_intf ->
-         let formatter sig_item =
-           let* config = Document.Merlin.mconfig intf_merlin in
-           let verbosity = config.query.verbosity in
-           let env = Mtyper.initial_env intf_typer in
-           Fiber.return
-             (Printtyp.wrap_printing_env ~verbosity env (fun () ->
-                Format.asprintf "%a@." Printtyp.signature [ sig_item ]))
-         in
-         let new_sigs = get_doc_signature impl_typer in
-         build_signature_edits ~old_intf ~new_sigs ~range ~formatter
-       | _ -> Code_error.raise "expected an interface" []))
-;;
+      let intf_uri = Document.uri doc in
+      let impl_uri =
+        Document.get_impl_intf_counterparts (Some intf_merlin) intf_uri
+        |> List.hd
+      in
+      let* impl_doc =
+        match Document_store.get_opt state.store impl_uri with
+        | Some impl -> Fiber.return (Some impl)
+        | None -> open_document_from_file state impl_uri
+      in
+      match impl_doc with
+      | None -> Fiber.return []
+      | Some impl_doc -> (
+        let impl_merlin = Document.merlin_exn impl_doc in
+        (* CR-someday bwiedenbeck: These calls to Merlin to get the type information (and
+             the subsequent processing we do with it) are expensive on large documents.
+             This can cause problems if someone is trying to invoke some other code action,
+             because the LSP currently determines which CAs are possible by trying them all.
+             We've decided for now to allow slow code actions (especially since users are
+             less likely to be doing lots of little CAs in the mli file) and think more
+             about the broader CA protocol in the future. *)
+        let* typers =
+          Fiber.parallel_map [ intf_merlin; impl_merlin ] ~f:get_typer
+        in
+        let intf_typer = Base.List.hd_exn typers in
+        let impl_typer = Base.List.nth_exn typers 1 in
+        match Mtyper.get_typedtree intf_typer with
+        | `Interface old_intf ->
+          let formatter sig_item =
+            let* config = Document.Merlin.mconfig intf_merlin in
+            let verbosity = config.query.verbosity in
+            let env = Mtyper.initial_env intf_typer in
+            Fiber.return
+              (Printtyp.wrap_printing_env ~verbosity env (fun () ->
+                   Format.asprintf "%a@." Printtyp.signature [ sig_item ]))
+          in
+          let new_sigs = get_doc_signature impl_typer in
+          build_signature_edits ~old_intf ~new_sigs ~range ~formatter
+        | _ -> Code_error.raise "expected an interface" []))