Add some missing custom request

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
 

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  }
+]
+```

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`

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`

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

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

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)
+;;

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

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)
+;;

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