diff --git a/ocaml-lsp-server/src/destruct.ml b/ocaml-lsp-server/src/code_actions/action_destruct.ml similarity index 100% rename from ocaml-lsp-server/src/destruct.ml rename to ocaml-lsp-server/src/code_actions/action_destruct.ml diff --git a/ocaml-lsp-server/src/destruct.mli b/ocaml-lsp-server/src/code_actions/action_destruct.mli similarity index 100% rename from ocaml-lsp-server/src/destruct.mli rename to ocaml-lsp-server/src/code_actions/action_destruct.mli diff --git a/ocaml-lsp-server/src/inferred_intf.ml b/ocaml-lsp-server/src/code_actions/action_inferred_intf.ml similarity index 93% rename from ocaml-lsp-server/src/inferred_intf.ml rename to ocaml-lsp-server/src/code_actions/action_inferred_intf.ml index 6e0e28d37..f95ac557e 100644 --- a/ocaml-lsp-server/src/inferred_intf.ml +++ b/ocaml-lsp-server/src/code_actions/action_inferred_intf.ml @@ -59,11 +59,7 @@ let code_action doc (state : State.t) (params : CodeActionParams.t) = | Impl -> Fiber.return (Ok None) | Intf -> ( let intf_uri = Document.uri doc in - let intf_path = Uri.to_path intf_uri in - let impl_path = - Switch_impl_intf.get_intf_impl_counterparts intf_path |> List.hd - in - let impl_uri = Uri.of_path impl_path in + let impl_uri = Document.get_impl_intf_counterparts intf_uri |> List.hd in let* impl = match Document_store.get_opt state.store impl_uri with | None -> force_open_document state impl_uri diff --git a/ocaml-lsp-server/src/inferred_intf.mli b/ocaml-lsp-server/src/code_actions/action_inferred_intf.mli similarity index 100% rename from ocaml-lsp-server/src/inferred_intf.mli rename to ocaml-lsp-server/src/code_actions/action_inferred_intf.mli diff --git a/ocaml-lsp-server/src/custom_requests/req_switch_impl_intf.ml b/ocaml-lsp-server/src/custom_requests/req_switch_impl_intf.ml new file mode 100644 index 000000000..0f86fc059 --- /dev/null +++ b/ocaml-lsp-server/src/custom_requests/req_switch_impl_intf.ml @@ -0,0 +1,29 @@ +open Import + +let capability = ("handleSwitchImplIntf", `Bool true) + +let meth = "ocamllsp/switchImplIntf" + +(** see the spec for [ocamllsp/switchImplIntf] *) +let switch (param : DocumentUri.t) : (Json.t, Jsonrpc.Response.Error.t) result = + let files_to_switch_to = + Document.get_impl_intf_counterparts (Uri.t_of_yojson (`String param)) + in + Ok + (Json.yojson_of_list + (fun uri -> uri |> Uri.to_string |> fun s -> `String s) + files_to_switch_to) + +let on_request ~(params : Json.t option) state = + Fiber.return + ( match params with + | Some (`String (file_uri : DocumentUri.t)) -> + let open Result.O in + let+ res = switch file_uri in + (res, state) + | Some _ + | None -> + Error + (Jsonrpc.Response.Error.make ~code:InvalidRequest + ~message:"ocamllsp/switchImplIntf must receive param : DocumentUri.t" + ()) ) diff --git a/ocaml-lsp-server/src/switch_impl_intf.mli b/ocaml-lsp-server/src/custom_requests/req_switch_impl_intf.mli similarity index 76% rename from ocaml-lsp-server/src/switch_impl_intf.mli rename to ocaml-lsp-server/src/custom_requests/req_switch_impl_intf.mli index bf21ccd27..666926a64 100644 --- a/ocaml-lsp-server/src/switch_impl_intf.mli +++ b/ocaml-lsp-server/src/custom_requests/req_switch_impl_intf.mli @@ -4,8 +4,6 @@ val capability : string * Json.t val meth : string -val get_intf_impl_counterparts : string -> string list - val on_request : params:Json.t option -> State.t diff --git a/ocaml-lsp-server/src/document.ml b/ocaml-lsp-server/src/document.ml index f695d39ce..4130989b0 100644 --- a/ocaml-lsp-server/src/document.ml +++ b/ocaml-lsp-server/src/document.ml @@ -145,3 +145,45 @@ let dispatch_exn (doc : t) command = Query_commands.dispatch pipeline command) let close t = Scheduler.cancel_timer t.timer + +let get_impl_intf_counterparts uri = + let uri_s = Uri.to_string uri in + let fpath = + match String.split ~on:':' uri_s with + | [ scheme; path ] -> + if scheme = "file" then + Uri.t_of_yojson (`String uri_s) |> Uri.to_path + else + path + | _ -> failwith "provided file URI (param) doesn't follow URI spec" + in + let fname = Filename.basename fpath in + let ml, mli, re, rei, mll, mly = ("ml", "mli", "re", "rei", "mll", "mly") in + let exts_to_switch_to = + match Syntax.of_fname fname with + | Ocaml -> ( + match Kind.of_fname fname with + | Intf -> [ ml; mly; mll; re ] + | Impl -> [ mli; mly; mll; rei ] ) + | Reason -> ( + match Kind.of_fname fname with + | Intf -> [ re; ml ] + | Impl -> [ rei; mli ] ) + | Ocamllex -> [ mli; rei ] + | Menhir -> [ mli; rei ] + in + let fpath_w_ext ext = Filename.remove_extension fpath ^ "." ^ ext in + let find_switch exts = + List.filter_map exts ~f:(fun ext -> + let file_to_switch_to = fpath_w_ext ext in + Option.some_if (Sys.file_exists file_to_switch_to) file_to_switch_to) + in + let files_to_switch_to = + match find_switch exts_to_switch_to with + | [] -> + let switch_to_ext = List.hd exts_to_switch_to in + let switch_to_fpath = fpath_w_ext switch_to_ext in + [ switch_to_fpath ] + | to_switch_to -> to_switch_to + in + List.map ~f:Uri.of_path files_to_switch_to diff --git a/ocaml-lsp-server/src/document.mli b/ocaml-lsp-server/src/document.mli index 795b99bd8..609ca95c4 100644 --- a/ocaml-lsp-server/src/document.mli +++ b/ocaml-lsp-server/src/document.mli @@ -54,3 +54,9 @@ val dispatch : t -> 'a Query_protocol.t -> ('a, exn) result Fiber.t val dispatch_exn : t -> 'a Query_protocol.t -> 'a Fiber.t val close : t -> unit Fiber.t + +(** [get_impl_intf_counterparts uri] returns the implementation/interface + counterparts for the URI [uri]. + + For instance, the counterparts of the file {/file.ml} are {[/file.mli]}. *) +val get_impl_intf_counterparts : Uri.t -> Uri.t list diff --git a/ocaml-lsp-server/src/dune b/ocaml-lsp-server/src/dune index 46259f88d..bfc375711 100644 --- a/ocaml-lsp-server/src/dune +++ b/ocaml-lsp-server/src/dune @@ -7,3 +7,5 @@ merlin.analysis merlin.kernel merlin.merlin_utils merlin.parsing merlin.query_commands merlin.query_protocol merlin.specific merlin.typing merlin.utils octavius omd ppx_yojson_conv_lib result stdune yojson)) + +(include_subdirs unqualified) diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index e6ca56634..d33a377c4 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -15,8 +15,8 @@ let not_supported () = let initialize_info : InitializeResult.t = let codeActionProvider = let codeActionKinds = - [ CodeActionKind.Other Destruct.action_kind - ; CodeActionKind.Other Inferred_intf.action_kind + [ CodeActionKind.Other Action_destruct.action_kind + ; CodeActionKind.Other Action_inferred_intf.action_kind ] in `CodeActionOptions (CodeActionOptions.create ~codeActionKinds ()) @@ -43,7 +43,7 @@ let initialize_info : InitializeResult.t = [ ( "ocamllsp" , `Assoc [ ("interfaceSpecificLangId", `Bool true) - ; Switch_impl_intf.capability + ; Req_switch_impl_intf.capability ] ) ] in @@ -184,10 +184,10 @@ let code_action server (params : CodeActionParams.t) = let open Fiber.O in let+ code_action_results = Fiber.parallel_map ~f:code_action - [ ( CodeActionKind.Other Destruct.action_kind - , fun () -> Destruct.code_action doc params ) - ; ( CodeActionKind.Other Inferred_intf.action_kind - , fun () -> Inferred_intf.code_action doc state params ) + [ ( CodeActionKind.Other Action_destruct.action_kind + , fun () -> Action_destruct.code_action doc params ) + ; ( CodeActionKind.Other Action_inferred_intf.action_kind + , fun () -> Action_inferred_intf.code_action doc state params ) ] in let open Result.O in @@ -662,7 +662,7 @@ let on_request : match req with | Client_request.UnknownRequest { meth; params } -> ( match - [ (Switch_impl_intf.meth, Switch_impl_intf.on_request) ] + [ (Req_switch_impl_intf.meth, Req_switch_impl_intf.on_request) ] |> List.assoc_opt meth with | None -> diff --git a/ocaml-lsp-server/src/switch_impl_intf.ml b/ocaml-lsp-server/src/switch_impl_intf.ml deleted file mode 100644 index 34d1c18a1..000000000 --- a/ocaml-lsp-server/src/switch_impl_intf.ml +++ /dev/null @@ -1,68 +0,0 @@ -open Import - -let capability = ("handleSwitchImplIntf", `Bool true) - -let meth = "ocamllsp/switchImplIntf" - -let get_intf_impl_counterparts fpath = - let fname = Filename.basename fpath in - let ml, mli, re, rei, mll, mly = ("ml", "mli", "re", "rei", "mll", "mly") in - let exts_to_switch_to = - match Document.Syntax.of_fname fname with - | Ocaml -> ( - match Document.Kind.of_fname fname with - | Intf -> [ ml; mly; mll; re ] - | Impl -> [ mli; mly; mll; rei ] ) - | Reason -> ( - match Document.Kind.of_fname fname with - | Intf -> [ re; ml ] - | Impl -> [ rei; mli ] ) - | Ocamllex -> [ mli; rei ] - | Menhir -> [ mli; rei ] - in - let fpath_w_ext ext = Filename.remove_extension fpath ^ "." ^ ext in - let find_switch exts = - List.filter_map exts ~f:(fun ext -> - let file_to_switch_to = fpath_w_ext ext in - Option.some_if (Sys.file_exists file_to_switch_to) file_to_switch_to) - in - let files_to_switch_to = - match find_switch exts_to_switch_to with - | [] -> - let switch_to_ext = List.hd exts_to_switch_to in - let switch_to_fpath = fpath_w_ext switch_to_ext in - [ switch_to_fpath ] - | to_switch_to -> to_switch_to - in - files_to_switch_to - -(** see the spec for [ocamllsp/switchImplIntf] *) -let switch (param : DocumentUri.t) : (Json.t, Jsonrpc.Response.Error.t) result = - let fpath = - match String.split ~on:':' param with - | [ scheme; path ] -> - if scheme = "file" then - Uri.t_of_yojson (`String param) |> Uri.to_path - else - path - | _ -> failwith "provided file URI (param) doesn't follow URI spec" - in - let files_to_switch_to = get_intf_impl_counterparts fpath in - Ok - (Json.yojson_of_list - (fun fpath -> Uri.of_path fpath |> Uri.to_string |> fun s -> `String s) - files_to_switch_to) - -let on_request ~(params : Json.t option) state = - Fiber.return - ( match params with - | Some (`String (file_uri : DocumentUri.t)) -> - let open Result.O in - let+ res = switch file_uri in - (res, state) - | Some _ - | None -> - Error - (Jsonrpc.Response.Error.make ~code:InvalidRequest - ~message:"ocamllsp/switchImplIntf must receive param : DocumentUri.t" - ()) )