diff --git a/CHANGES.md b/CHANGES.md index 9171fac4e..499d3f004 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,9 @@ - Make `code-lens` for nested let bindings configurable (#1567) - Add support for `.mlx` files, including formatting via `ocamlformat-mlx` and most OCaml LSP features (diagnostics, code actions, hover, etc.) (#1528) +- Add `typeExpression` custom request (#1576) +- Add `locate` custom request (#1576) +- Add `phrase` custom request (#1576) ## Fixes diff --git a/ocaml-lsp-server/docs/ocamllsp/locate-spec.md b/ocaml-lsp-server/docs/ocamllsp/locate-spec.md new file mode 100644 index 000000000..b1a53ef58 --- /dev/null +++ b/ocaml-lsp-server/docs/ocamllsp/locate-spec.md @@ -0,0 +1,39 @@ +# Locate Request + +## Description + +The LSP protocol natively allows searching for definitions and +declarations; however, Merlin's `locate` command allows passing a +prefix to search for identifiers, hence the presence of this custom +request to offer more control in certain contexts. + +## Client Capability + +There is no client capability relative to this request. + +## Server capability + +- propert name: `handleLocate` +- property type: `boolean` + +## Request + +- method: `ocamllsp/locate` +- params: + + ```json + { + "uri": TextDocumentIdentifier, + "position": Position, + "kind": <"definition" | "declaration" | "type-definition">, + "prefix?": string + } + ``` +## Response + +```json +[ + { "range": Range, + "uri": DocumentIdentifier } +] +``` diff --git a/ocaml-lsp-server/docs/ocamllsp/phrase-spec.md b/ocaml-lsp-server/docs/ocamllsp/phrase-spec.md new file mode 100644 index 000000000..7fed03730 --- /dev/null +++ b/ocaml-lsp-server/docs/ocamllsp/phrase-spec.md @@ -0,0 +1,31 @@ +# Phrase Request + +## Description + +This custom request returns the position of the next or previous +phrase (top-level definition or module definition). + +## Client Capability + +There is no client capability relative to this request. + +## Server capability + +- propert name: `handlePhrase` +- property type: `boolean` + +## Request + +- method: `ocamllsp/phrase` +- params: + + ```json + { + "uri": TextDocumentIdentifier, + "position": Position, + "target": <"next" | "prev">, + } + ``` +## Response + +- result: `Position | null` diff --git a/ocaml-lsp-server/docs/ocamllsp/typeExpression-spec.md b/ocaml-lsp-server/docs/ocamllsp/typeExpression-spec.md new file mode 100644 index 000000000..4a4af8b90 --- /dev/null +++ b/ocaml-lsp-server/docs/ocamllsp/typeExpression-spec.md @@ -0,0 +1,31 @@ +# Type Expression Request + +## Description + +Returns the type of a given expression as a string. + +## Client capability + +There is no client capability relative to this request. + +## Server capability + +- property name: `handleTypeExpression` +- property type: `boolean` + +## Request + +- method: `ocamllsp/typeExpression` +- params: + + ```json + { + "uri": TextDocumentIdentifier, + "position": Position, + "expression": string, + } + ``` + +## Response + +- result: `string | null` diff --git a/ocaml-lsp-server/src/custom_requests/custom_request.ml b/ocaml-lsp-server/src/custom_requests/custom_request.ml index 0152afe10..1bb47a0bb 100644 --- a/ocaml-lsp-server/src/custom_requests/custom_request.ml +++ b/ocaml-lsp-server/src/custom_requests/custom_request.ml @@ -10,3 +10,6 @@ module Wrapping_ast_node = Req_wrapping_ast_node module Get_documentation = Req_get_documentation module Type_search = Req_type_search module Merlin_jump = Req_merlin_jump +module Phrase = Req_phrase +module Type_expression = Req_type_expression +module Locate = Req_locate diff --git a/ocaml-lsp-server/src/custom_requests/custom_request.mli b/ocaml-lsp-server/src/custom_requests/custom_request.mli index 13027eb59..a5c005bce 100644 --- a/ocaml-lsp-server/src/custom_requests/custom_request.mli +++ b/ocaml-lsp-server/src/custom_requests/custom_request.mli @@ -12,3 +12,6 @@ module Wrapping_ast_node = Req_wrapping_ast_node module Get_documentation = Req_get_documentation module Type_search = Req_type_search module Merlin_jump = Req_merlin_jump +module Phrase = Req_phrase +module Type_expression = Req_type_expression +module Locate = Req_locate diff --git a/ocaml-lsp-server/src/custom_requests/req_locate.ml b/ocaml-lsp-server/src/custom_requests/req_locate.ml new file mode 100644 index 000000000..cd767c56d --- /dev/null +++ b/ocaml-lsp-server/src/custom_requests/req_locate.ml @@ -0,0 +1,79 @@ +open Import + +let meth = "ocamllsp/locate" +let capability = "handleLocate", `Bool true + +module Request_params = struct + type t = + { text_document : TextDocumentIdentifier.t + ; kind : [ `Type_definition | `Definition | `Declaration ] + ; position : Position.t + ; prefix : string option + } + + let create ?prefix ~text_document ~kind ~position () = + { text_document; position; prefix; kind } + ;; + + let yojson_of_t { text_document; kind; position; prefix } = + match TextDocumentIdentifier.yojson_of_t text_document with + | `Assoc assoc -> + let position = "position", Position.yojson_of_t position + and kind = + ( "kind" + , `String + (match kind with + | `Type_definition -> "type-definition" + | `Declaration -> "declaration" + | `Definition -> "definition") ) + and prefix = + ( "prefix" + , match prefix with + | None -> `Null + | Some p -> `String p ) + in + `Assoc (position :: prefix :: kind :: assoc) + | _ -> (* unreachable *) assert false + ;; + + let kind_of_yojson json = + let open Yojson.Safe.Util in + json + |> member "kind" + |> to_string_option + |> Option.map ~f:String.lowercase_ascii + |> function + | Some "type-definition" -> `Type_definition + | Some "declaration" -> `Declaration + | _ -> `Definition + ;; + + let t_of_yojson json = + let open Yojson.Safe.Util in + let text_document = json |> TextDocumentIdentifier.t_of_yojson + and kind = kind_of_yojson json + and position = json |> member "position" |> Position.t_of_yojson + and prefix = json |> member "prefix" |> to_string_option in + create ~text_document ~position ~kind ?prefix () + ;; +end + +type t = Location.t + +let t_of_yojson = Location.t_of_yojson + +let yojson_of_t = function + | Some (`Location locs) -> `List (List.map ~f:Location.yojson_of_t locs) + | _ -> `Null +;; + +let on_request ~params state = + Fiber.of_thunk (fun () -> + let open Fiber.O in + let Request_params.{ text_document = { uri }; position; prefix; kind } = + (Option.value ~default:(`Assoc []) params :> Yojson.Safe.t) + |> Request_params.t_of_yojson + in + let+ result = Definition_query.run ?prefix kind state uri position in + yojson_of_t result) +;; diff --git a/ocaml-lsp-server/src/custom_requests/req_locate.mli b/ocaml-lsp-server/src/custom_requests/req_locate.mli new file mode 100644 index 000000000..17d4bd380 --- /dev/null +++ b/ocaml-lsp-server/src/custom_requests/req_locate.mli @@ -0,0 +1,22 @@ +open Import + +module Request_params : sig + type t + + val yojson_of_t : t -> Json.t + + val create + : ?prefix:string + -> text_document:TextDocumentIdentifier.t + -> kind:[ `Type_definition | `Definition | `Declaration ] + -> position:Position.t + -> unit + -> t +end + +type t + +val t_of_yojson : Json.t -> t +val meth : string +val capability : string * [> `Bool of bool ] +val on_request : params:Jsonrpc.Structured.t option -> State.t -> Json.t Fiber.t diff --git a/ocaml-lsp-server/src/custom_requests/req_phrase.ml b/ocaml-lsp-server/src/custom_requests/req_phrase.ml new file mode 100644 index 000000000..640b27faa --- /dev/null +++ b/ocaml-lsp-server/src/custom_requests/req_phrase.ml @@ -0,0 +1,80 @@ +open Import + +let meth = "ocamllsp/phrase" +let capability = "handlePhrase", `Bool true + +module Request_params = struct + type t = + { text_document : TextDocumentIdentifier.t + ; position : Position.t + ; target : [ `Prev | `Next ] + } + + let create ~text_document ~position ~target = { text_document; position; target } + + let yojson_of_t { text_document; position; target } = + match TextDocumentIdentifier.yojson_of_t text_document with + | `Assoc assoc -> + let position = "position", Position.yojson_of_t position + and target = + ( "target" + , `String + (match target with + | `Next -> "next" + | `Prev -> "prev") ) + in + `Assoc (position :: target :: assoc) + | _ -> (* unreachable *) assert false + ;; + + let target_of_yojson json = + let open Yojson.Safe.Util in + json + |> member "target" + |> to_string_option + |> Option.map ~f:String.lowercase_ascii + |> function + | Some "next" -> `Next + | Some "prev" -> `Prev + | _ -> `Next + ;; + + let t_of_yojson json = + let open Yojson.Safe.Util in + let text_document = json |> TextDocumentIdentifier.t_of_yojson + and position = json |> member "position" |> Position.t_of_yojson + and target = target_of_yojson json in + create ~text_document ~position ~target + ;; +end + +type t = Position.t + +let t_of_yojson x = Position.t_of_yojson x + +let with_pipeline state uri f = + let doc = Document_store.get state.State.store uri in + match Document.kind doc with + | `Other -> Fiber.return `Null + | `Merlin merlin -> Document.Merlin.with_pipeline_exn merlin f +;; + +let make_phrase_command position target = Query_protocol.Phrase (target, position) + +let dispatch_phrase position target pipeline = + let position = Position.logical position in + let command = make_phrase_command position target in + let result = Query_commands.dispatch pipeline command in + match Position.of_lexical_position result with + | None -> `Null + | Some pos -> Position.yojson_of_t pos +;; + +let on_request ~params state = + Fiber.of_thunk (fun () -> + let Request_params.{ text_document = { uri }; position; target } = + (Option.value ~default:(`Assoc []) params :> Yojson.Safe.t) + |> Request_params.t_of_yojson + in + with_pipeline state uri @@ dispatch_phrase position target) +;; diff --git a/ocaml-lsp-server/src/custom_requests/req_phrase.mli b/ocaml-lsp-server/src/custom_requests/req_phrase.mli new file mode 100644 index 000000000..21e4d6647 --- /dev/null +++ b/ocaml-lsp-server/src/custom_requests/req_phrase.mli @@ -0,0 +1,20 @@ +open Import + +module Request_params : sig + type t + + val yojson_of_t : t -> Json.t + + val create + : text_document:TextDocumentIdentifier.t + -> position:Position.t + -> target:[ `Next | `Prev ] + -> t +end + +type t + +val t_of_yojson : Json.t -> t +val meth : string +val capability : string * [> `Bool of bool ] +val on_request : params:Jsonrpc.Structured.t option -> State.t -> Json.t Fiber.t diff --git a/ocaml-lsp-server/src/custom_requests/req_type_expression.ml b/ocaml-lsp-server/src/custom_requests/req_type_expression.ml new file mode 100644 index 000000000..210b414df --- /dev/null +++ b/ocaml-lsp-server/src/custom_requests/req_type_expression.ml @@ -0,0 +1,72 @@ +open Import + +let meth = "ocamllsp/typeExpression" +let capability = "handleTypeExpression", `Bool true + +module Request_params = struct + type t = + { text_document : TextDocumentIdentifier.t + ; position : Position.t + ; expression : string + } + + let create ~text_document ~position ~expression = + { text_document; position; expression } + ;; + + let yojson_of_t { text_document; position; expression } = + match TextDocumentIdentifier.yojson_of_t text_document with + | `Assoc assoc -> + let position = "position", Position.yojson_of_t position + and expression = "expression", `String expression in + `Assoc (position :: expression :: assoc) + | _ -> (* unreachable *) assert false + ;; + + let t_of_yojson json = + let open Yojson.Safe.Util in + let text_document = json |> TextDocumentIdentifier.t_of_yojson + and position = json |> member "position" |> Position.t_of_yojson + and expression = json |> member "expression" |> to_string in + create ~text_document ~position ~expression + ;; +end + +type t = string + +let t_of_yojson = Yojson.Safe.Util.to_string + +let with_pipeline state uri f = + let doc = Document_store.get state.State.store uri in + match Document.kind doc with + | `Other -> Fiber.return None + | `Merlin merlin -> Document.Merlin.with_pipeline_exn merlin f +;; + +let make_type_expr_command position expression = + Query_protocol.Type_expr (expression, position) +;; + +let dispatch_type_expr position expression pipeline = + let position = Position.logical position in + let command = make_type_expr_command position expression in + let result = Query_commands.dispatch pipeline command in + Some result +;; + +let on_request ~params state = + let open Fiber.O in + Fiber.of_thunk (fun () -> + let Request_params.{ text_document = { uri }; position; expression } = + (Option.value ~default:(`Assoc []) params :> Yojson.Safe.t) + |> Request_params.t_of_yojson + in + let* typ = with_pipeline state uri (dispatch_type_expr position expression) in + match typ with + | Some typ -> + let* result = Ocamlformat_rpc.format_type ~typ state.ocamlformat_rpc in + (match result with + | Error _ -> Fiber.return (`String typ) + | Ok typ -> Fiber.return (`String (String.trim ~drop:(Char.equal '\n') typ))) + | None -> Fiber.return `Null) +;; diff --git a/ocaml-lsp-server/src/custom_requests/req_type_expression.mli b/ocaml-lsp-server/src/custom_requests/req_type_expression.mli new file mode 100644 index 000000000..27abbec5e --- /dev/null +++ b/ocaml-lsp-server/src/custom_requests/req_type_expression.mli @@ -0,0 +1,20 @@ +open Import + +module Request_params : sig + type t + + val yojson_of_t : t -> Json.t + + val create + : text_document:TextDocumentIdentifier.t + -> position:Position.t + -> expression:string + -> t +end + +type t + +val t_of_yojson : Json.t -> t +val meth : string +val capability : string * [> `Bool of bool ] +val on_request : params:Jsonrpc.Structured.t option -> State.t -> Json.t Fiber.t diff --git a/ocaml-lsp-server/src/definition_query.ml b/ocaml-lsp-server/src/definition_query.ml index e836f3e3b..29045dd52 100644 --- a/ocaml-lsp-server/src/definition_query.ml +++ b/ocaml-lsp-server/src/definition_query.ml @@ -30,7 +30,7 @@ let location_of_merlin_loc uri : _ -> (_, string) result = function `Location locs)) ;; -let run kind (state : State.t) uri position = +let run kind (state : State.t) ?prefix uri position = let* () = Fiber.return () in let doc = Document_store.get state.store uri in match Document.kind doc with @@ -39,8 +39,8 @@ let run kind (state : State.t) uri position = let command, name = let pos = Position.logical position in match kind with - | `Definition -> Query_protocol.Locate (None, `ML, pos), "definition" - | `Declaration -> Query_protocol.Locate (None, `MLI, pos), "declaration" + | `Definition -> Query_protocol.Locate (prefix, `ML, pos), "definition" + | `Declaration -> Query_protocol.Locate (prefix, `MLI, pos), "declaration" | `Type_definition -> Query_protocol.Locate_type pos, "type definition" in let* result = Document.Merlin.dispatch_exn ~name doc command in diff --git a/ocaml-lsp-server/src/definition_query.mli b/ocaml-lsp-server/src/definition_query.mli index b1024439a..787280534 100644 --- a/ocaml-lsp-server/src/definition_query.mli +++ b/ocaml-lsp-server/src/definition_query.mli @@ -3,6 +3,7 @@ open Import val run : [ `Definition | `Declaration | `Type_definition ] -> State.t + -> ?prefix:string -> Uri.t -> Position.t -> [> `Location of Import.Location.t list ] option Fiber.t diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index 46cc7ba5f..0531eea63 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -99,6 +99,9 @@ let initialize_info (client_capabilities : ClientCapabilities.t) : InitializeRes ; Req_construct.capability ; Req_type_search.capability ; Req_merlin_jump.capability + ; Req_phrase.capability + ; Req_type_expression.capability + ; Req_locate.capability ] ) ] in @@ -536,25 +539,29 @@ let on_request | Client_request.UnknownRequest { meth; params } -> (match List.assoc - [ ( Req_switch_impl_intf.meth - , fun ~params state -> - Fiber.of_thunk (fun () -> - Fiber.return (Req_switch_impl_intf.on_request ~params state)) ) - ; Req_infer_intf.meth, Req_infer_intf.on_request - ; Req_typed_holes.meth, Req_typed_holes.on_request - ; Req_jump_to_typed_hole.meth, Req_jump_to_typed_hole.on_request - ; Req_merlin_call_compatible.meth, Req_merlin_call_compatible.on_request - ; Req_type_enclosing.meth, Req_type_enclosing.on_request - ; Req_get_documentation.meth, Req_get_documentation.on_request - ; Req_merlin_jump.meth, Req_merlin_jump.on_request - ; Req_wrapping_ast_node.meth, Req_wrapping_ast_node.on_request - ; Req_type_search.meth, Req_type_search.on_request - ; Req_construct.meth, Req_construct.on_request - ; ( Semantic_highlighting.Debug.meth_request_full - , Semantic_highlighting.Debug.on_request_full ) - ; ( Req_hover_extended.meth - , fun ~params _ -> Req_hover_extended.on_request ~params rpc ) - ] meth + [ ( Req_switch_impl_intf.meth + , fun ~params state -> + Fiber.of_thunk (fun () -> + Fiber.return (Req_switch_impl_intf.on_request ~params state)) ) + ; Req_infer_intf.meth, Req_infer_intf.on_request + ; Req_typed_holes.meth, Req_typed_holes.on_request + ; Req_jump_to_typed_hole.meth, Req_jump_to_typed_hole.on_request + ; Req_merlin_call_compatible.meth, Req_merlin_call_compatible.on_request + ; Req_type_enclosing.meth, Req_type_enclosing.on_request + ; Req_get_documentation.meth, Req_get_documentation.on_request + ; Req_merlin_jump.meth, Req_merlin_jump.on_request + ; Req_wrapping_ast_node.meth, Req_wrapping_ast_node.on_request + ; Req_type_search.meth, Req_type_search.on_request + ; Req_construct.meth, Req_construct.on_request + ; ( Semantic_highlighting.Debug.meth_request_full + , Semantic_highlighting.Debug.on_request_full ) + ; ( Req_hover_extended.meth + , fun ~params _ -> Req_hover_extended.on_request ~params rpc ) + ; Req_phrase.meth, Req_phrase.on_request + ; Req_type_expression.meth, Req_type_expression.on_request + ; Req_locate.meth, Req_locate.on_request + ] + meth with | None -> Jsonrpc.Response.Error.raise diff --git a/ocaml-lsp-server/test/e2e-new/dune b/ocaml-lsp-server/test/e2e-new/dune index 71cb2a6ac..25d37bbb7 100644 --- a/ocaml-lsp-server/test/e2e-new/dune +++ b/ocaml-lsp-server/test/e2e-new/dune @@ -69,6 +69,9 @@ documentation document_symbol merlin_jump + phrase + type_expression + locate type_search with_pp with_ppx diff --git a/ocaml-lsp-server/test/e2e-new/locate.ml b/ocaml-lsp-server/test/e2e-new/locate.ml new file mode 100644 index 000000000..586645d7a --- /dev/null +++ b/ocaml-lsp-server/test/e2e-new/locate.ml @@ -0,0 +1,105 @@ +open Test.Import +module Req = Ocaml_lsp_server.Custom_request.Locate + +module Util = struct + let call_locate ?prefix ?(kind = `Definition) ~position client = + let text_document = + TextDocumentIdentifier.create ~uri:(DocumentUri.of_path "test.ml") + in + let params = + Req.Request_params.create ~text_document ?prefix ~kind ~position () + |> Req.Request_params.yojson_of_t + |> Jsonrpc.Structured.t_of_yojson + |> Option.some + in + let req = Lsp.Client_request.UnknownRequest { meth = Req.meth; params } in + Client.request client req + ;; + + let sanitize_path = function + | `List ranges -> + `List + (List.map + ~f:(function + | `Assoc [ range; ("uri", `String value) ] -> + let new_value = + value + |> String.split_on_char ~sep:'/' + |> List.last + |> function + | None -> "unknown" + | Some x -> "file:///" ^ x + in + `Assoc [ range; "uri", `String new_value ] + | x -> x) + ranges) + | x -> x + ;; + + let test ?prefix ?(kind = `Definition) ~line ~character source = + let position = Position.create ~line ~character in + let request client = + let open Fiber.O in + let+ response = call_locate ?prefix ~kind ~position client in + Test.print_result (sanitize_path response) + in + Helpers.test source request + ;; +end + +let%expect_test "Locate identifier - 1" = + let source = {| let x = 10 let y = 11 |} + and line = 0 + and character = 23 in + Util.test ~line ~character ~prefix:"x" source; + [%expect + {| + [ + { + "range": { + "end": { "character": 5, "line": 0 }, + "start": { "character": 5, "line": 0 } + }, + "uri": "file:///test.ml" + } + ] + |}] +;; + +let%expect_test "Locate identifier - 2" = + let source = {| let x = 10 let y = 11 let z = 10 |} + and line = 0 + and character = 23 in + Util.test ~line ~character ~prefix:"y" source; + [%expect + {| + [ + { + "range": { + "end": { "character": 16, "line": 0 }, + "start": { "character": 16, "line": 0 } + }, + "uri": "file:///test.ml" + } + ] + |}] +;; + +let%expect_test "Locate identifier - 3" = + let source = {| let x = 10 let y = 11 |} + and line = 0 + and character = 23 in + Util.test ~line ~character ~prefix:"List.map" source; + [%expect + {| + [ + { + "range": { + "end": { "character": 24, "line": 81 }, + "start": { "character": 24, "line": 81 } + }, + "uri": "file:///list.ml" + } + ] + |}] +;; diff --git a/ocaml-lsp-server/test/e2e-new/phrase.ml b/ocaml-lsp-server/test/e2e-new/phrase.ml new file mode 100644 index 000000000..dcbb15c2c --- /dev/null +++ b/ocaml-lsp-server/test/e2e-new/phrase.ml @@ -0,0 +1,126 @@ +open Test.Import +module Req = Ocaml_lsp_server.Custom_request.Phrase + +module Util = struct + let call_phrase ~target ~position client = + let text_document = + TextDocumentIdentifier.create ~uri:(DocumentUri.of_path "test.ml") + in + let params = + Req.Request_params.create ~text_document ~position ~target + |> Req.Request_params.yojson_of_t + |> Jsonrpc.Structured.t_of_yojson + |> Option.some + in + let req = Lsp.Client_request.UnknownRequest { meth = Req.meth; params } in + Client.request client req + ;; + + let test ~target ~line ~character source = + let position = Position.create ~line ~character in + let request client = + let open Fiber.O in + let+ response = call_phrase ~target ~position client in + Test.print_result response + in + Helpers.test source request + ;; +end + +let%expect_test "Jump to the next phrase - 1" = + let source = {| let x = 10 let y = 11 |} + and line = 0 + and character = 9 + and target = `Next in + Util.test ~line ~character ~target source; + [%expect {| { "character": 12, "line": 0 } |}] +;; + +let%expect_test "Jump to the previous phrase - 1" = + let source = {| let x = 10 let y = 11 |} + and line = 0 + and character = 12 + and target = `Prev in + Util.test ~line ~character ~target source; + [%expect {| { "character": 1, "line": 0 } |}] +;; + +let%expect_test "Jump to the next phrase - 2" = + let source = + {| module T = struct + let x = 10 + let y = 11 +end +let z = 10 +module R = List +|} + and line = 1 + and character = 8 + and target = `Next in + Util.test ~line ~character ~target source; + [%expect {| { "character": 4, "line": 2 } |}] +;; + +let%expect_test "Jump to the next phrase - 3" = + let source = + {| module T = struct + let x = 10 + let y = 11 +end +let z = 10 +module R = List +|} + and line = 2 + and character = 4 + and target = `Next in + Util.test ~line ~character ~target source; + [%expect {| { "character": 0, "line": 4 } |}] +;; + +let%expect_test "Jump to the next phrase - 4" = + let source = + {| module T = struct + let x = 10 + let y = 11 +end +let z = 10 +module R = List +|} + and line = 4 + and character = 0 + and target = `Next in + Util.test ~line ~character ~target source; + [%expect {| { "character": 0, "line": 5 } |}] +;; + +let%expect_test "Jump to the previous phrase - 2" = + let source = + {| module T = struct + let x = 10 + let y = 11 +end +let z = 10 +module R = List +|} + and line = 5 + and character = 0 + and target = `Prev in + Util.test ~line ~character ~target source; + [%expect {| { "character": 0, "line": 4 } |}] +;; + +let%expect_test "Jump to the previous phrase - 3" = + let source = + {| module T = struct + let x = 10 + let y = 11 +end +let z = 10 +module R = List +|} + and line = 4 + and character = 0 + and target = `Prev in + Util.test ~line ~character ~target source; + [%expect {| { "character": 1, "line": 0 } |}] +;; diff --git a/ocaml-lsp-server/test/e2e-new/start_stop.ml b/ocaml-lsp-server/test/e2e-new/start_stop.ml index f369cf4a1..65489d7e2 100644 --- a/ocaml-lsp-server/test/e2e-new/start_stop.ml +++ b/ocaml-lsp-server/test/e2e-new/start_stop.ml @@ -96,7 +96,10 @@ let%expect_test "start/stop" = "handleGetDocumentation": true, "handleConstruct": true, "handleTypeSearch": true, - "handleJump": true + "handleJump": true, + "handlePhrase": true, + "handleTypeExpression": true, + "handleLocate": true } }, "foldingRangeProvider": true, diff --git a/ocaml-lsp-server/test/e2e-new/type_expression.ml b/ocaml-lsp-server/test/e2e-new/type_expression.ml new file mode 100644 index 000000000..882a56e1a --- /dev/null +++ b/ocaml-lsp-server/test/e2e-new/type_expression.ml @@ -0,0 +1,73 @@ +open Test.Import +module Req = Ocaml_lsp_server.Custom_request.Type_expression + +module Util = struct + let call_type_expr ~position ~expression client = + let text_document = + TextDocumentIdentifier.create ~uri:(DocumentUri.of_path "test.ml") + in + let params = + Req.Request_params.create ~text_document ~position ~expression + |> Req.Request_params.yojson_of_t + |> Jsonrpc.Structured.t_of_yojson + |> Option.some + in + let req = Lsp.Client_request.UnknownRequest { meth = Req.meth; params } in + Client.request client req + ;; + + let test ~line ~character ~expression source = + let position = Position.create ~line ~character in + let request client = + let open Fiber.O in + let+ response = call_type_expr ~position ~expression client in + Test.print_result response + in + Helpers.test source request + ;; +end + +let%expect_test "Type an expression - 1" = + let source = {| let x = 10 let y = 11 |} + and line = 0 + and character = 9 + and expression = {|"foo"|} in + Util.test ~line ~character ~expression source; + [%expect {| "string" |}] +;; + +let%expect_test "Type an expression - 2" = + let source = {| let x = 10 let y = function `Foo -> () | _ -> () |} + and line = 1 + and character = 0 + and expression = {|List.map|} in + Util.test ~line ~character ~expression source; + [%expect {| "('a -> 'b) -> 'a list -> 'b list" |}] +;; + +let%expect_test "Type an expression - with unbound value" = + let source = {| let x = 10 let y = function `Foo -> () | _ -> () |} + and line = 1 + and character = 0 + and expression = {|z|} in + Util.test ~line ~character ~expression source; + [%expect {| "Unbound value z" |}] +;; + +let%expect_test "Type an expression - with menhir error" = + let source = {| let x = 10 let y = function `Foo -> () | _ -> () |} + and line = 1 + and character = 0 + and expression = {|('a, ) list|} in + Util.test ~line ~character ~expression source; + [%expect {| "Ocaml_preprocess.Parser_raw.MenhirBasics.Error" |}] +;; + +let%expect_test "Type a big expression" = + let source = {| let x = 10 let y = function `Foo -> () | _ -> () |} + and line = 1 + and character = 0 + and expression = {|List|} in + Util.test ~line ~character ~expression source; + [%expect {| "sig\n type 'a t = 'a list = [] | ( :: ) of 'a * 'a list\n\n val length : 'a list -> int\n val compare_lengths : 'a list -> 'b list -> int\n val compare_length_with : 'a list -> int -> int\n val is_empty : 'a list -> bool\n val cons : 'a -> 'a list -> 'a list\n val singleton : 'a -> 'a list\n val hd : 'a list -> 'a\n val tl : 'a list -> 'a list\n val nth : 'a list -> int -> 'a\n val nth_opt : 'a list -> int -> 'a option\n val rev : 'a list -> 'a list\n val init : int -> (int -> 'a) -> 'a list\n val append : 'a list -> 'a list -> 'a list\n val rev_append : 'a list -> 'a list -> 'a list\n val concat : 'a list list -> 'a list\n val flatten : 'a list list -> 'a list\n val equal : ('a -> 'a -> bool) -> 'a list -> 'a list -> bool\n val compare : ('a -> 'a -> int) -> 'a list -> 'a list -> int\n val iter : ('a -> unit) -> 'a list -> unit\n val iteri : (int -> 'a -> unit) -> 'a list -> unit\n val map : ('a -> 'b) -> 'a list -> 'b list\n val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list\n val rev_map : ('a -> 'b) -> 'a list -> 'b list\n val filter_map : ('a -> 'b option) -> 'a list -> 'b list\n val concat_map : ('a -> 'b list) -> 'a list -> 'b list\n\n val fold_left_map :\n ('acc -> 'a -> 'acc * 'b) ->\n 'acc ->\n 'a list ->\n 'acc * 'b list\n\n val fold_left :\n ('acc -> 'a -> 'acc) -> 'acc -> 'a list -> 'acc\n\n val fold_right :\n ('a -> 'acc -> 'acc) -> 'a list -> 'acc -> 'acc\n\n val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit\n val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list\n\n val rev_map2 :\n ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list\n\n val fold_left2 :\n ('acc -> 'a -> 'b -> 'acc) ->\n 'acc ->\n 'a list ->\n 'b list ->\n 'acc\n\n val fold_right2 :\n ('a -> 'b -> 'acc -> 'acc) ->\n 'a list ->\n 'b list ->\n 'acc ->\n 'acc\n\n val for_all : ('a -> bool) -> 'a list -> bool\n val exists : ('a -> bool) -> 'a list -> bool\n\n val for_all2 :\n ('a -> 'b -> bool) -> 'a list -> 'b list -> bool\n\n val exists2 :\n ('a -> 'b -> bool) -> 'a list -> 'b list -> bool\n\n val mem : 'a -> 'a list -> bool\n val memq : 'a -> 'a list -> bool\n val find : ('a -> bool) -> 'a list -> 'a\n val find_opt : ('a -> bool) -> 'a list -> 'a option\n val find_index : ('a -> bool) -> 'a list -> int option\n val find_map : ('a -> 'b option) -> 'a list -> 'b option\n\n val find_mapi :\n (int -> 'a -> 'b option) -> 'a list -> 'b option\n\n val filter : ('a -> bool) -> 'a list -> 'a list\n val find_all : ('a -> bool) -> 'a list -> 'a list\n val filteri : (int -> 'a -> bool) -> 'a list -> 'a list\n val take : int -> 'a list -> 'a list\n val drop : int -> 'a list -> 'a list\n val take_while : ('a -> bool) -> 'a list -> 'a list\n val drop_while : ('a -> bool) -> 'a list -> 'a list\n val partition : ('a -> bool) -> 'a list -> 'a list * 'a list\n\n val partition_map :\n ('a -> ('b, 'c) Either.t) -> 'a list -> 'b list * 'c list\n\n val assoc : 'a -> ('a * 'b) list -> 'b\n val assoc_opt : 'a -> ('a * 'b) list -> 'b option\n val assq : 'a -> ('a * 'b) list -> 'b\n val assq_opt : 'a -> ('a * 'b) list -> 'b option\n val mem_assoc : 'a -> ('a * 'b) list -> bool\n val mem_assq : 'a -> ('a * 'b) list -> bool\n val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list\n val remove_assq : 'a -> ('a * 'b) list -> ('a * 'b) list\n val split : ('a * 'b) list -> 'a list * 'b list\n val combine : 'a list -> 'b list -> ('a * 'b) list\n val sort : ('a -> 'a -> int) -> 'a list -> 'a list\n val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list\n val fast_sort : ('a -> 'a -> int) -> 'a list -> 'a list\n val sort_uniq : ('a -> 'a -> int) -> 'a list -> 'a list\n\n val merge :\n ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list\n\n val to_seq : 'a list -> 'a Seq.t\n val of_seq : 'a Seq.t -> 'a list\nend" |}] +;;