Type search custom request

CHANGES.md

@@ -15,6 +15,9 @@
 
 - Add a code-action for syntactic and semantic movement shortcuts based on Merlin's Jump command (#1364)
 
+- Add custom
+  [`ocamllsp/polaritysearch`](/ocaml-lsp-server/docs/ocamllsp/polaritySearch-spec.md) request (#1369)
+
 ## Fixes
 
 - Kill unnecessary ocamlformat processes with sigterm rather than sigint or

ocaml-lsp-server/docs/ocamllsp/polaritySearch-spec.md

@@ -0,0 +1,40 @@
+# Polarity Search Request
+
+## Description
+
+This custom request allows clients to perform a polarity-based search at a specific position within a text document based on finding functions or types that match a specific query pattern.
+
+## Server capability
+
+- property name: `handlePolaritySearch`
+- property type: `boolean`
+
+## Request
+
+```js
+export interface PolaritySearchParams extends TexDocumentPositionParams
+{
+    query: string;
+    limit: int
+}
+```
+- method: `ocamllsp/polaritySearch`
+- params:
+    - `TextDocumentPositionParams`: This is an existing interface that includes:
+            - `TextDocumentIdentifier`: Specifies the document uri for which the request is sent.
+            - `Position`: Specifies the cursor position.
+        More details can be found in the [TextDocumentPositionParams - LSP Specification](https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#textDocumentPositionParams).
+    - `query`: The search pattern.
+    - `limit`: The number of results to return
+
+## Response
+
+```js
+result: PolaritySearch | null
+export interface PolaritySearch {
+    type entry = { path : string; desc : string }
+    type t = entry list
+}
+```
+- `t`: A list of completion entries that match the query.
+- A response with null result is returned if no entries are found.

ocaml-lsp-server/src/custom_requests/custom_request.ml

@@ -6,3 +6,4 @@ module Typed_holes = Req_typed_holes
 module Type_enclosing = Req_type_enclosing
 module Wrapping_ast_node = Req_wrapping_ast_node
 module Get_documentation = Req_get_documentation
+module PolaritySearch = Req_polarity_search

ocaml-lsp-server/src/custom_requests/custom_request.mli

@@ -8,3 +8,4 @@ module Typed_holes = Req_typed_holes
 module Type_enclosing = Req_type_enclosing
 module Wrapping_ast_node = Req_wrapping_ast_node
 module Get_documentation = Req_get_documentation
+module PolaritySearch = Req_polarity_search

ocaml-lsp-server/src/custom_requests/req_polarity_search.ml

@@ -0,0 +1,102 @@
+open Import
+module TextDocumentPositionParams = Lsp.Types.TextDocumentPositionParams
+
+let meth = "ocamllsp/polaritySearch"
+let capability = "handlePolaritySearch", `Bool true
+
+module PolaritySearchParams = struct
+  type t =
+    { text_document : TextDocumentIdentifier.t
+    ; position : Position.t
+    ; limit : int
+    ; query : string
+    }
+
+  let t_of_yojson json =
+    let open Yojson.Safe.Util in
+    let textDocumentPosition = Lsp.Types.TextDocumentPositionParams.t_of_yojson json in
+    let query = json |> member "query" |> to_string in
+    let limit = json |> member "limit" |> to_int in
+    { position = textDocumentPosition.position
+    ; text_document = textDocumentPosition.textDocument
+    ; query
+    ; limit
+    }
+  ;;
+
+  let yojson_of_t { text_document; position; query; limit } =
+    `Assoc
+      (("textDocument", TextDocumentIdentifier.yojson_of_t text_document)
+       :: ("position", Position.yojson_of_t position)
+       :: ("limit", `Int limit)
+       :: [ "query", `String query ])
+  ;;
+end
+
+module PolaritySearch = struct
+  type entry =
+    { path : string
+    ; desc : string
+    }
+
+  type t = entry list
+
+  let entry_of_yojson json =
+    let open Yojson.Safe.Util in
+    let path = json |> member "path" |> to_string in
+    let desc = json |> member "type" |> to_string in
+    { path; desc }
+  ;;
+
+  let yojson_of_entry { path; desc } =
+    `Assoc [ "path", `String path; "type", `String desc ]
+  ;;
+
+  let t_of_yojson json =
+    let open Yojson.Safe.Util in
+    json |> to_list |> List.map ~f:entry_of_yojson
+  ;;
+
+  let yojson_of_t entries = `List (List.map ~f:yojson_of_entry entries)
+end
+
+type t = PolaritySearch.t
+
+let t_of_yojson json = PolaritySearch.t_of_yojson json
+
+module Request_params = struct
+  type t = PolaritySearchParams.t
+
+  let yojson_of_t t = PolaritySearchParams.yojson_of_t t
+
+  let create text_document position limit query : t =
+    { text_document; position; limit; query }
+  ;;
+end
+
+let dispatch merlin position limit query =
+  Document.Merlin.with_pipeline_exn merlin (fun pipeline ->
+    let position = Position.logical position in
+    let query = Query_protocol.Polarity_search (query, position) in
+    let completions = Query_commands.dispatch pipeline query in
+    PolaritySearch.yojson_of_t
+      (List.map
+         ~f:(fun entry ->
+           { PolaritySearch.path = entry.Query_protocol.Compl.name; desc = entry.desc })
+         (if List.length completions.entries > limit
+          then List.sub ~pos:0 ~len:limit completions.entries
+          else completions.entries)))
+;;
+
+let on_request ~params state =
+  Fiber.of_thunk (fun () ->
+    let params = (Option.value ~default:(`Assoc []) params :> Yojson.Safe.t) in
+    let PolaritySearchParams.{ text_document; position; limit; query } =
+      PolaritySearchParams.t_of_yojson params
+    in
+    let uri = text_document.uri in
+    let doc = Document_store.get state.State.store uri in
+    match Document.kind doc with
+    | `Other -> Fiber.return `Null
+    | `Merlin merlin -> dispatch merlin position limit query)
+;;

ocaml-lsp-server/src/custom_requests/req_polarity_search.mli

@@ -0,0 +1,15 @@
+open Import
+
+module Request_params : sig
+  type t
+
+  val yojson_of_t : t -> Json.t
+  val create : TextDocumentIdentifier.t -> Position.t -> int -> 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

ocaml-lsp-server/src/ocaml_lsp_server.ml

@@ -539,6 +539,7 @@ let on_request
        ; Req_type_enclosing.meth, Req_type_enclosing.on_request
        ; Req_get_documentation.meth, Req_get_documentation.on_request
        ; Req_wrapping_ast_node.meth, Req_wrapping_ast_node.on_request
+       ; Req_polarity_search.meth, Req_polarity_search.on_request
        ; ( Semantic_highlighting.Debug.meth_request_full
          , Semantic_highlighting.Debug.on_request_full )
        ; ( Req_hover_extended.meth

ocaml-lsp-server/test/e2e-new/dune

@@ -62,6 +62,7 @@
     test
     type_enclosing
     documentation
+    polarity_search
     with_pp
     with_ppx
     workspace_change_config))))

ocaml-lsp-server/test/e2e-new/polarity_search.ml

@@ -0,0 +1,99 @@
+open Test.Import
+module Req = Ocaml_lsp_server.Custom_request.PolaritySearch
+
+module Util = struct
+  let call_search position query limit client =
+    let uri = DocumentUri.of_path "test.ml" in
+    let text_document = TextDocumentIdentifier.create ~uri in
+    let params =
+      Req.Request_params.create text_document position limit query
+      |> Req.Request_params.yojson_of_t
+      |> Jsonrpc.Structured.t_of_yojson
+      |> Option.some
+    in
+    let req =
+      Lsp.Client_request.UnknownRequest { meth = "ocamllsp/polaritySearch"; params }
+    in
+    Client.request client req
+  ;;
+
+  let test ~line ~character ~query limit source =
+    let position = Position.create ~character ~line in
+    let request client =
+      let open Fiber.O in
+      let+ response = call_search position query limit client in
+      Test.print_result response
+    in
+    Helpers.test source request
+  ;;
+end
+
+let%expect_test "Search for a simple query that takes an int and returns a string" =
+  let source = "" in
+  let line = 1 in
+  let character = 0 in
+  Util.test ~line ~character ~query:"-int +string" 20 source;
+  [%expect
+    {|
+    [
+      { "path": "string_of_int", "type": "int -> string" },
+      { "path": "string_of_int", "type": "int -> string" },
+      { "path": "Stdlib__Int.to_string", "type": "int -> string" },
+      { "path": "really_input_string", "type": "in_channel -> int -> string" },
+      { "path": "really_input_string", "type": "in_channel -> int -> string" },
+      {
+        "path": "Stdlib__Digest.channel",
+        "type": "in_channel -> int -> Stdlib__Digest.t"
+      },
+      { "path": "Stdlib__String.make", "type": "int -> char -> string" },
+      { "path": "Stdlib__StringLabels.make", "type": "int -> char -> string" },
+      {
+        "path": "Stdlib__Digest.BLAKE128.channel",
+        "type": "in_channel -> int -> Stdlib__Digest.BLAKE128.t"
+      },
+      {
+        "path": "Stdlib__Digest.BLAKE256.channel",
+        "type": "in_channel -> int -> Stdlib__Digest.BLAKE256.t"
+      },
+      {
+        "path": "Stdlib__Digest.BLAKE512.channel",
+        "type": "in_channel -> int -> Stdlib__Digest.BLAKE512.t"
+      },
+      {
+        "path": "Stdlib__Digest.MD5.channel",
+        "type": "in_channel -> int -> Stdlib__Digest.MD5.t"
+      },
+      {
+        "path": "Stdlib__In_channel.really_input_string",
+        "type": "Stdlib__In_channel.t -> int -> string option"
+      },
+      {
+        "path": "Stdlib__Printexc.Slot.format",
+        "type": "int -> Stdlib__Printexc.Slot.t -> string option"
+      },
+      {
+        "path": "Stdlib__Buffer.sub",
+        "type": "Stdlib__Buffer.t -> int -> int -> string"
+      },
+      {
+        "path": "Stdlib__Bytes.sub_string",
+        "type": "bytes -> int -> int -> string"
+      },
+      {
+        "path": "Stdlib__BytesLabels.sub_string",
+        "type": "bytes -> pos:int -> len:int -> string"
+      },
+      {
+        "path": "Stdlib__Digest.subbytes",
+        "type": "bytes -> int -> int -> Stdlib__Digest.t"
+      },
+      {
+        "path": "Stdlib__Digest.substring",
+        "type": "string -> int -> int -> Stdlib__Digest.t"
+      },
+      {
+        "path": "Stdlib__Lexing.sub_lexeme",
+        "type": "Stdlib__Lexing.lexbuf -> int -> int -> string"
+      }
+    ] |}]
+;;