From 7bb7fb94fb4560b1022d7324f939ed169867f911 Mon Sep 17 00:00:00 2001 From: mattiasdrp Date: Wed, 12 Mar 2025 12:43:40 +0100 Subject: [PATCH] Requests: Refactor implIntf and inferIntf parameters Currently implIntf and inferIntf accept a DocumentUri while typedHoles accepts ``` { uri: DocumentUri } ``` When looking at how vscode-ocaml-platform handles it: - For implIntf and inferIntf: ``` let source_uri = Uri.toString (TextDocument.uri document) () in ``` - For typedHoles ``` let uri = TextDocument.uri doc in ``` I don't see any reason to not have the three requests have the same type of parameter --- .../docs/ocamllsp/inferIntf-spec.md | 9 +++- .../docs/ocamllsp/switchImplIntf-spec.md | 11 +++-- .../src/custom_requests/req_infer_intf.ml | 36 +++++----------- .../custom_requests/req_switch_impl_intf.ml | 43 ++++++------------- .../src/custom_requests/req_typed_holes.ml | 42 +----------------- .../src/custom_requests/req_typed_holes.mli | 7 --- .../src/custom_requests/request_uri_params.ml | 38 ++++++++++++++++ .../custom_requests/request_uri_params.mli | 6 +++ 8 files changed, 86 insertions(+), 106 deletions(-) create mode 100644 ocaml-lsp-server/src/custom_requests/request_uri_params.ml create mode 100644 ocaml-lsp-server/src/custom_requests/request_uri_params.mli diff --git a/ocaml-lsp-server/docs/ocamllsp/inferIntf-spec.md b/ocaml-lsp-server/docs/ocamllsp/inferIntf-spec.md index 1da302e65..2f4f0db14 100644 --- a/ocaml-lsp-server/docs/ocamllsp/inferIntf-spec.md +++ b/ocaml-lsp-server/docs/ocamllsp/inferIntf-spec.md @@ -22,7 +22,14 @@ property type: `boolean` ## Request - method: `ocamllsp/inferIntf` -- params: `DocumentUri` (see [`DocumentUri`](https://microsoft.github.io/language-server-protocol/specifications/specification-current/#uri) in LSP specification) +- params: + +```json +{ + "uri": DocumentUri, +} +``` +(see [`DocumentUri`](https://microsoft.github.io/language-server-protocol/specifications/specification-current/#uri) in LSP specification) ## Response diff --git a/ocaml-lsp-server/docs/ocamllsp/switchImplIntf-spec.md b/ocaml-lsp-server/docs/ocamllsp/switchImplIntf-spec.md index 9eef06f95..98706b4ff 100644 --- a/ocaml-lsp-server/docs/ocamllsp/switchImplIntf-spec.md +++ b/ocaml-lsp-server/docs/ocamllsp/switchImplIntf-spec.md @@ -25,11 +25,16 @@ property type: `boolean` ## Request - method: `ocamllsp/switchImplIntf` -- params: `DocumentUri` (see [`DocumentUri`](https://microsoft.github.io/language-server-protocol/specifications/specification-current/#uri) in LSP specification) +- params: + +```json +{ + "uri": DocumentUri, +} +``` +(see [`DocumentUri`](https://microsoft.github.io/language-server-protocol/specifications/specification-current/#uri) in LSP specification) ## Response - result: DocumentUri[] (non-empty) - error: code and message set in case an exception happens during the `ocamllsp/switchImplIntf` request. - - diff --git a/ocaml-lsp-server/src/custom_requests/req_infer_intf.ml b/ocaml-lsp-server/src/custom_requests/req_infer_intf.ml index 289c190e5..d6c8324eb 100644 --- a/ocaml-lsp-server/src/custom_requests/req_infer_intf.ml +++ b/ocaml-lsp-server/src/custom_requests/req_infer_intf.ml @@ -6,32 +6,18 @@ let meth = "ocamllsp/inferIntf" let on_request ~(params : Jsonrpc.Structured.t option) (state : State.t) = Fiber.of_thunk (fun () -> - match params with - | Some (`List [ json_uri ]) -> - let json_uri = DocumentUri.t_of_yojson json_uri in - (match Document_store.get_opt state.store json_uri with - | None -> - Jsonrpc.Response.Error.raise - (Jsonrpc.Response.Error.make - ~code:InvalidParams - ~message: - "ocamllsp/inferIntf received a URI for an unloaded file. Load the file \ - first." - ()) - | Some impl -> - let+ intf = Inference.infer_intf_for_impl impl in - Json.t_of_yojson (`String intf)) - | Some json -> - Jsonrpc.Response.Error.raise - (Jsonrpc.Response.Error.make - ~code:InvalidRequest - ~message:"The input parameter for ocamllsp/inferIntf is invalid" - ~data:(`Assoc [ "param", (json :> Json.t) ]) - ()) + let uri = Request_uri_params.parse_exn params in + let doc = Document_store.get_opt state.store uri in + match doc with | None -> Jsonrpc.Response.Error.raise (Jsonrpc.Response.Error.make - ~code:InvalidRequest - ~message:"ocamllsp/inferIntf must receive param: DocumentUri.t" - ())) + ~code:InvalidParams + ~message: + "ocamllsp/inferIntf received a URI for an unloaded file. Load the file \ + first." + ()) + | Some impl -> + let+ intf = Inference.infer_intf_for_impl impl in + Json.t_of_yojson (`String intf)) ;; 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 index e9c27d844..f0772c65b 100644 --- a/ocaml-lsp-server/src/custom_requests/req_switch_impl_intf.ml +++ b/ocaml-lsp-server/src/custom_requests/req_switch_impl_intf.ml @@ -10,33 +10,18 @@ let switch merlin_doc (param : DocumentUri.t) : Json.t = ;; let on_request ~(params : Jsonrpc.Structured.t option) (state : State.t) = - match params with - | Some (`List [ json_uri ]) -> - let uri = DocumentUri.t_of_yojson json_uri in - (match Document_store.get_opt state.store uri with - | Some doc -> - (match Document.kind doc with - | `Merlin merlin_doc -> switch (Some merlin_doc) uri - | `Other -> - Jsonrpc.Response.Error.raise - (Jsonrpc.Response.Error.make - ~code:InvalidRequest - ~message: - "Document with this URI is not supported by ocamllsp/switchImplIntf" - ~data:(`Assoc [ "param", (json_uri :> Json.t) ]) - ())) - | None -> switch None uri) - | Some json -> - Jsonrpc.Response.Error.raise - (Jsonrpc.Response.Error.make - ~code:InvalidRequest - ~message:"The input parameter for ocamllsp/switchImplIntf is invalid" - ~data:(`Assoc [ "param", (json :> Json.t) ]) - ()) - | None -> - Jsonrpc.Response.Error.raise - (Jsonrpc.Response.Error.make - ~code:InvalidRequest - ~message:"ocamllsp/switchImplIntf must receive param: DocumentUri.t" - ()) + let uri = Request_uri_params.parse_exn params in + let doc = Document_store.get_opt state.store uri in + match doc with + | Some doc -> + (match Document.kind doc with + | `Merlin merlin_doc -> switch (Some merlin_doc) uri + | `Other -> + Jsonrpc.Response.Error.raise + (Jsonrpc.Response.Error.make + ~code:InvalidRequest + ~message:"Document with this URI is not supported by ocamllsp/switchImplIntf" + ~data:(Uri.yojson_of_t uri) + ())) + | None -> switch None uri ;; diff --git a/ocaml-lsp-server/src/custom_requests/req_typed_holes.ml b/ocaml-lsp-server/src/custom_requests/req_typed_holes.ml index 083d6a7a0..38837063d 100644 --- a/ocaml-lsp-server/src/custom_requests/req_typed_holes.ml +++ b/ocaml-lsp-server/src/custom_requests/req_typed_holes.ml @@ -4,46 +4,6 @@ open Fiber.O let capability = "handleTypedHoles", `Bool true let meth = "ocamllsp/typedHoles" -module Request_params = struct - type t = Uri.t - - (* Request params must have the form as in the given string. *) - let expected_params = `Assoc [ "uri", `String "" ] - let create uri = uri - - let t_of_structured_json params : t option = - match params with - | `Assoc [ ("uri", uri) ] -> - let uri = Uri.t_of_yojson uri in - Some uri - | _ -> None - ;; - - let parse_exn (params : Jsonrpc.Structured.t option) : t = - let raise_invalid_params ?data ~message () = - Jsonrpc.Response.Error.raise - @@ Jsonrpc.Response.Error.make - ?data - ~code:Jsonrpc.Response.Error.Code.InvalidParams - ~message - () - in - match params with - | None -> raise_invalid_params ~message:"Expected params but received none" () - | Some params -> - (match t_of_structured_json params with - | Some uri -> uri - | None -> - let error_json = - `Assoc - [ "params_expected", expected_params; "params_received", (params :> Json.t) ] - in - raise_invalid_params ~message:"Unxpected parameter format" ~data:error_json ()) - ;; - - let yojson_of_t = Uri.yojson_of_t -end - type t = Range.t list let yojson_of_t holes = @@ -57,7 +17,7 @@ let t_of_yojson list = let on_request ~(params : Jsonrpc.Structured.t option) (state : State.t) = Fiber.of_thunk (fun () -> - let uri = Request_params.parse_exn params in + let uri = Request_uri_params.parse_exn params in let store = state.store in let doc = Document_store.get_opt store uri in match doc with diff --git a/ocaml-lsp-server/src/custom_requests/req_typed_holes.mli b/ocaml-lsp-server/src/custom_requests/req_typed_holes.mli index c6ae69590..ccef92502 100644 --- a/ocaml-lsp-server/src/custom_requests/req_typed_holes.mli +++ b/ocaml-lsp-server/src/custom_requests/req_typed_holes.mli @@ -1,12 +1,5 @@ open Import -module Request_params : sig - type t - - val create : Uri.t -> t - val yojson_of_t : t -> Json.t -end - type t val t_of_yojson : Json.t -> t diff --git a/ocaml-lsp-server/src/custom_requests/request_uri_params.ml b/ocaml-lsp-server/src/custom_requests/request_uri_params.ml new file mode 100644 index 000000000..7638d13d3 --- /dev/null +++ b/ocaml-lsp-server/src/custom_requests/request_uri_params.ml @@ -0,0 +1,38 @@ +open Import + +type t = Uri.t + +(* Request params must have the form as in the given string. *) +let expected_params = `Assoc [ "uri", `String "" ] + +let t_of_structured_json params : t option = + match params with + | `Assoc [ ("uri", uri) ] -> + let uri = Uri.t_of_yojson uri in + Some uri + | _ -> None +;; + +let parse_exn (params : Jsonrpc.Structured.t option) : t = + let raise_invalid_params ?data ~message () = + Jsonrpc.Response.Error.raise + @@ Jsonrpc.Response.Error.make + ?data + ~code:Jsonrpc.Response.Error.Code.InvalidParams + ~message + () + in + match params with + | None -> raise_invalid_params ~message:"Expected params but received none" () + | Some params -> + (match t_of_structured_json params with + | Some uri -> uri + | None -> + let error_json = + `Assoc + [ "params_expected", expected_params; "params_received", (params :> Json.t) ] + in + raise_invalid_params ~message:"Unexpected parameter format" ~data:error_json ()) +;; + +let yojson_of_t = Uri.yojson_of_t diff --git a/ocaml-lsp-server/src/custom_requests/request_uri_params.mli b/ocaml-lsp-server/src/custom_requests/request_uri_params.mli new file mode 100644 index 000000000..1248d3d40 --- /dev/null +++ b/ocaml-lsp-server/src/custom_requests/request_uri_params.mli @@ -0,0 +1,6 @@ +open Import + +type t = Uri.t + +val yojson_of_t : t -> Json.t +val parse_exn : Jsonrpc.Structured.t option -> t