From 693422ce4ed66b5afd3d59afbe427e9ff4bb26e2 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sun, 1 Dec 2024 12:31:31 -0300 Subject: [PATCH 1/6] initial lsp --- dune | 2 +- dune-project | 10 +++ lsp/dune | 5 ++ lsp/rescriptlsp.ml | 200 +++++++++++++++++++++++++++++++++++++++++++++ rescript-lsp.opam | 28 +++++++ 5 files changed, 244 insertions(+), 1 deletion(-) create mode 100644 lsp/dune create mode 100644 lsp/rescriptlsp.ml create mode 100644 rescript-lsp.opam diff --git a/dune b/dune index 91a5df6eca9..2903c721981 100644 --- a/dune +++ b/dune @@ -1 +1 @@ -(dirs compiler tests analysis tools) +(dirs compiler tests analysis tools lsp) diff --git a/dune-project b/dune-project index 0532a0380d3..010440baacf 100644 --- a/dune-project +++ b/dune-project @@ -62,3 +62,13 @@ (= 1.6.9)) analysis dune)) + +(package + (name rescript-lsp) + (synopsis "ReScript LSP") + (depends + (ocaml + (>= 4.10)) + analysis + lsp + dune)) diff --git a/lsp/dune b/lsp/dune new file mode 100644 index 00000000000..ec167bdd89c --- /dev/null +++ b/lsp/dune @@ -0,0 +1,5 @@ +(executable + (name rescriptlsp) + (package rescript-lsp) + (public_name rescript-lsp) + (libraries lsp eio eio_main)) diff --git a/lsp/rescriptlsp.ml b/lsp/rescriptlsp.ml new file mode 100644 index 00000000000..cd95c4aa0eb --- /dev/null +++ b/lsp/rescriptlsp.ml @@ -0,0 +1,200 @@ +module Io : sig + type 'a t + + val return : 'a -> 'a t + val raise : exn -> 'a t + val await : 'a t -> 'a + val async : (sw:Eio.Switch.t -> ('a, exn) result) -> 'a t + + module O : sig + val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t + val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t + end +end = struct + type 'a t = sw:Eio.Switch.t -> ('a, exn) result Eio.Promise.t + + let await t = Eio.Switch.run @@ fun sw -> Eio.Promise.await_exn (t ~sw) + let return value ~sw:_ = Eio.Promise.create_resolved (Ok value) + let error desc ~sw:_ = Eio.Promise.create_resolved (Error desc) + + let async f ~sw = + let promise, resolver = Eio.Promise.create () in + ( Eio.Fiber.fork ~sw @@ fun () -> + try + let result = f ~sw in + Eio.Promise.resolve resolver result + with exn -> Eio.Promise.resolve resolver @@ Error exn ); + promise + + let bind t f = + async @@ fun ~sw -> + match Eio.Promise.await (t ~sw) with + | Ok value -> Eio.Promise.await @@ f value ~sw + | Error desc -> Error desc + + let raise = error + + module O = struct + let ( let+ ) x f = bind x @@ fun value -> return @@ f value + let ( let* ) = bind + end +end + +module Chan : sig + type input + type output + + (* eio *) + (* val of_source : 'a Eio.Flow.source -> input *) + (* val with_sink : 'a Eio.Flow.sink -> (output -> 'a) -> 'a *) + val of_source : [> Eio__Flow.source_ty] Eio.Resource.t -> input + val with_sink : + [> Eio__Flow.sink_ty] Eio.Resource.t -> (output -> output) -> output + + (* lsp *) + val read_line : input -> string option Io.t + val read_exactly : input -> int -> string option Io.t + val write : output -> string list -> unit Io.t +end = struct + type input = {mutex: Eio.Mutex.t; buf: Eio.Buf_read.t} + type output = {mutex: Eio.Mutex.t; buf: Eio.Buf_write.t} + + (* TODO: magic numbers *) + let initial_size = 1024 + let max_size = 1024 * 1024 + + let of_source source : input = + let mutex = Eio.Mutex.create () in + let buf = Eio.Buf_read.of_flow ~initial_size ~max_size source in + {mutex; buf} + + let with_sink sink f : output = + let mutex = Eio.Mutex.create () in + Eio.Buf_write.with_flow ~initial_size sink @@ fun buf -> f @@ {mutex; buf} + + let read_line (input : input) = + (* let { mutex; buf } = input in *) + Io.async @@ fun ~sw:_ -> + (* TODO: what this protect does? *) + Eio.Mutex.use_rw ~protect:true input.mutex @@ fun () -> + match Eio.Buf_read.eof_seen input.buf with + | true -> Ok None + | false -> Ok (Some (Eio.Buf_read.line input.buf)) + + let read_exactly (input : input) size = + Io.async @@ fun ~sw:_ -> + Eio.Mutex.use_rw ~protect:true input.mutex @@ fun () -> + match Eio.Buf_read.eof_seen input.buf with + | true -> Ok None + | false -> Ok (Some (Eio.Buf_read.take size input.buf)) + + let write (output : output) (str : string list) = + Io.async @@ fun ~sw:_ -> + Eio.Mutex.use_rw ~protect:true output.mutex @@ fun () -> + (* TODO(@aspeddro): Remove List.hd? *) + Ok (Eio.Buf_write.string output.buf (List.hd str)) +end + +module Lsp_Io = Lsp.Io.Make (Io) (Chan) + +let request_of_jsonrpc request = + match Lsp.Client_request.of_jsonrpc request with + | Ok request -> request + | Error error -> raise (Lsp.Io.Error error) + +let notification_of_jsonrpc notification = + match Lsp.Client_notification.of_jsonrpc notification with + | Ok notification -> notification + | Error error -> raise (Lsp.Io.Error error) + +type channel = Chan.output + +type on_request = { + f: + 'response. + channel -> + 'response Lsp.Client_request.t -> + ('response, Jsonrpc.Response.Error.t) result; +} + +let notify channel notification = + (* TODO: fork here *) + (* TODO: buffering and async? *) + let notification = Lsp.Server_notification.to_jsonrpc notification in + Io.await @@ Lsp_Io.write channel @@ Notification notification + +let respond channel response = + Io.await @@ Lsp_Io.write channel @@ Response response + +let rec input_loop ~input ~output with_ = + (* TODO: buffering and async handling *) + match Io.await @@ Lsp_Io.read input with + | Some packet -> + let () = with_ packet in + input_loop ~input ~output with_ + | exception exn -> (* TODO: handle this exception *) raise exn + | None -> + (* TODO: this means EOF right? *) + () + +let listen ~input ~output ~on_request ~on_notification = + let on_request channel request = + (* TODO: error handling *) + let result = + let (E request) = request_of_jsonrpc request in + match on_request.f channel request with + | Ok result -> Ok (Lsp.Client_request.yojson_of_result request result) + | Error _error as error -> error + in + let response = Jsonrpc.Response.{id = request.id; result} in + respond channel response + in + let on_notification channel notification = + let notification = notification_of_jsonrpc notification in + on_notification channel notification + in + + let input = Chan.of_source input in + let a = Chan.with_sink output in + Chan.with_sink output @@ fun channel -> + input_loop ~input ~output @@ fun packet -> + (* TODO: make this async? *) + match packet with + | Notification notification -> on_notification channel notification + | Request request -> on_request channel request + | Batch_call calls -> + (* TODO: what if one fails? It should not prevents the others *) + List.iter + (fun call -> + match call with + | `Request request -> on_request channel request + | `Notification notification -> on_notification channel notification) + calls + (* TODO: can the server receive a response? + Yes but right now it will not be supported *) + | Response _ -> raise (Lsp.Io.Error "") + | Batch_response _ -> raise (Lsp.Io.Error "") + +(* open Lsp_error *) + +let initialization = + let open Lsp.Types in + let textDocumentSync = + `TextDocumentSyncOptions + (TextDocumentSyncOptions.create ~openClose:true + ~change:TextDocumentSyncKind.Full ~willSave:false + ~save:(`SaveOptions (SaveOptions.create ~includeText:false ())) + ~willSaveWaitUntil:false ()) + in + let capabilities = + ServerCapabilities.create ~textDocumentSync ~hoverProvider:(`Bool true) () + in + let serverInfo = + let version = "experimental" in + InitializeResult.create_serverInfo ~name:"rescriptlsp" ~version () + in + InitializeResult.create ~capabilities ~serverInfo () + +let main () = () + +let () = print_endline "rescript-lsp lolll" diff --git a/rescript-lsp.opam b/rescript-lsp.opam new file mode 100644 index 00000000000..70e10ebca29 --- /dev/null +++ b/rescript-lsp.opam @@ -0,0 +1,28 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "ReScript LSP" +maintainer: ["Hongbo Zhang " "Cristiano Calcagno"] +authors: ["Hongbo Zhang "] +license: "LGPL-3.0-or-later" +homepage: "https://github.com/rescript-lang/rescript-compiler" +bug-reports: "https://github.com/rescript-lang/rescript-compiler/issues" +depends: [ + "ocaml" {>= "4.10"} + "analysis" + "lsp" + "dune" +] +build: [ + ["dune" "subst"] {pinned} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] From 129af21f04c9b1db0d96e2bfadb174e4a78389c2 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Wed, 29 Apr 2026 00:06:34 -0300 Subject: [PATCH 2/6] update --- lsp/rescriptlsp.ml | 134 +++++++++++++++++++++------------------------ rescript-lsp.opam | 5 +- 2 files changed, 64 insertions(+), 75 deletions(-) diff --git a/lsp/rescriptlsp.ml b/lsp/rescriptlsp.ml index cd95c4aa0eb..57d66f16f7d 100644 --- a/lsp/rescriptlsp.ml +++ b/lsp/rescriptlsp.ml @@ -44,14 +44,9 @@ module Chan : sig type input type output - (* eio *) - (* val of_source : 'a Eio.Flow.source -> input *) - (* val with_sink : 'a Eio.Flow.sink -> (output -> 'a) -> 'a *) val of_source : [> Eio__Flow.source_ty] Eio.Resource.t -> input - val with_sink : - [> Eio__Flow.sink_ty] Eio.Resource.t -> (output -> output) -> output + val with_sink : [> Eio__Flow.sink_ty] Eio.Resource.t -> (output -> 'a) -> 'a - (* lsp *) val read_line : input -> string option Io.t val read_exactly : input -> int -> string option Io.t val write : output -> string list -> unit Io.t @@ -59,7 +54,6 @@ end = struct type input = {mutex: Eio.Mutex.t; buf: Eio.Buf_read.t} type output = {mutex: Eio.Mutex.t; buf: Eio.Buf_write.t} - (* TODO: magic numbers *) let initial_size = 1024 let max_size = 1024 * 1024 @@ -68,31 +62,32 @@ end = struct let buf = Eio.Buf_read.of_flow ~initial_size ~max_size source in {mutex; buf} - let with_sink sink f : output = + let with_sink sink f = let mutex = Eio.Mutex.create () in - Eio.Buf_write.with_flow ~initial_size sink @@ fun buf -> f @@ {mutex; buf} + Eio.Buf_write.with_flow ~initial_size sink @@ fun buf -> f {mutex; buf} let read_line (input : input) = - (* let { mutex; buf } = input in *) Io.async @@ fun ~sw:_ -> - (* TODO: what this protect does? *) Eio.Mutex.use_rw ~protect:true input.mutex @@ fun () -> - match Eio.Buf_read.eof_seen input.buf with - | true -> Ok None - | false -> Ok (Some (Eio.Buf_read.line input.buf)) + if Eio.Buf_read.eof_seen input.buf then Ok None + else + match Eio.Buf_read.line input.buf with + | line -> Ok (Some line) + | exception End_of_file -> Ok None let read_exactly (input : input) size = Io.async @@ fun ~sw:_ -> Eio.Mutex.use_rw ~protect:true input.mutex @@ fun () -> - match Eio.Buf_read.eof_seen input.buf with - | true -> Ok None - | false -> Ok (Some (Eio.Buf_read.take size input.buf)) + if Eio.Buf_read.eof_seen input.buf then Ok None + else + match Eio.Buf_read.take size input.buf with + | data -> Ok (Some data) + | exception End_of_file -> Ok None let write (output : output) (str : string list) = Io.async @@ fun ~sw:_ -> Eio.Mutex.use_rw ~protect:true output.mutex @@ fun () -> - (* TODO(@aspeddro): Remove List.hd? *) - Ok (Eio.Buf_write.string output.buf (List.hd str)) + Ok (List.iter (Eio.Buf_write.string output.buf) str) end module Lsp_Io = Lsp.Io.Make (Io) (Chan) @@ -107,75 +102,39 @@ let notification_of_jsonrpc notification = | Ok notification -> notification | Error error -> raise (Lsp.Io.Error error) -type channel = Chan.output - -type on_request = { - f: - 'response. - channel -> - 'response Lsp.Client_request.t -> - ('response, Jsonrpc.Response.Error.t) result; -} - -let notify channel notification = - (* TODO: fork here *) - (* TODO: buffering and async? *) - let notification = Lsp.Server_notification.to_jsonrpc notification in - Io.await @@ Lsp_Io.write channel @@ Notification notification - let respond channel response = Io.await @@ Lsp_Io.write channel @@ Response response -let rec input_loop ~input ~output with_ = - (* TODO: buffering and async handling *) +let rec input_loop ~input with_ = match Io.await @@ Lsp_Io.read input with | Some packet -> let () = with_ packet in - input_loop ~input ~output with_ - | exception exn -> (* TODO: handle this exception *) raise exn - | None -> - (* TODO: this means EOF right? *) - () + input_loop ~input with_ + | exception exn -> raise exn + | None -> () let listen ~input ~output ~on_request ~on_notification = - let on_request channel request = - (* TODO: error handling *) - let result = - let (E request) = request_of_jsonrpc request in - match on_request.f channel request with - | Ok result -> Ok (Lsp.Client_request.yojson_of_result request result) - | Error _error as error -> error - in - let response = Jsonrpc.Response.{id = request.id; result} in - respond channel response + let handle_request channel request = + respond channel (on_request channel request) in - let on_notification channel notification = - let notification = notification_of_jsonrpc notification in - on_notification channel notification + let handle_notification channel notification = + on_notification channel (notification_of_jsonrpc notification) in - let input = Chan.of_source input in - let a = Chan.with_sink output in Chan.with_sink output @@ fun channel -> - input_loop ~input ~output @@ fun packet -> - (* TODO: make this async? *) + input_loop ~input @@ fun packet -> match packet with - | Notification notification -> on_notification channel notification - | Request request -> on_request channel request + | Notification notification -> handle_notification channel notification + | Request request -> handle_request channel request | Batch_call calls -> - (* TODO: what if one fails? It should not prevents the others *) List.iter (fun call -> match call with - | `Request request -> on_request channel request - | `Notification notification -> on_notification channel notification) + | `Request request -> handle_request channel request + | `Notification notification -> handle_notification channel notification) calls - (* TODO: can the server receive a response? - Yes but right now it will not be supported *) - | Response _ -> raise (Lsp.Io.Error "") - | Batch_response _ -> raise (Lsp.Io.Error "") - -(* open Lsp_error *) + | Response _ -> raise (Lsp.Io.Error "unexpected response") + | Batch_response _ -> raise (Lsp.Io.Error "unexpected batch response") let initialization = let open Lsp.Types in @@ -195,6 +154,35 @@ let initialization = in InitializeResult.create ~capabilities ~serverInfo () -let main () = () - -let () = print_endline "rescript-lsp lolll" +let on_request _channel (jsonrpc_request : Jsonrpc.Request.t) : Jsonrpc.Response.t = + let result = + let (E request) = request_of_jsonrpc jsonrpc_request in + match request with + | Lsp.Client_request.Initialize _ -> + Ok (Lsp.Client_request.yojson_of_result request initialization) + | Shutdown -> Ok (Lsp.Client_request.yojson_of_result request ()) + | TextDocumentHover _ -> + Ok (Lsp.Client_request.yojson_of_result request None) + | _ -> + Error + (Jsonrpc.Response.Error.make + ~code:Jsonrpc.Response.Error.Code.MethodNotFound + ~message:"Method not supported" ()) + in + Jsonrpc.Response.{id = jsonrpc_request.id; result} + +let on_notification _channel notification = + match notification with + | Lsp.Client_notification.Initialized -> () + | TextDocumentDidOpen _ -> () + | TextDocumentDidChange _ -> () + | Exit -> exit 0 + | _ -> () + +let main () = + Eio_main.run @@ fun env -> + let stdin = Eio.Stdenv.stdin env in + let stdout = Eio.Stdenv.stdout env in + listen ~input:stdin ~output:stdout ~on_request ~on_notification + +let () = main () diff --git a/rescript-lsp.opam b/rescript-lsp.opam index 70e10ebca29..688d8475282 100644 --- a/rescript-lsp.opam +++ b/rescript-lsp.opam @@ -10,10 +10,11 @@ depends: [ "ocaml" {>= "4.10"} "analysis" "lsp" - "dune" + "dune" {>= "3.17"} + "odoc" {with-doc} ] build: [ - ["dune" "subst"] {pinned} + ["dune" "subst"] {dev} [ "dune" "build" From 6b65a255c0cac1a9e43da5e3ed49ea6fcf6a42dc Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Thu, 30 Apr 2026 09:13:16 -0300 Subject: [PATCH 3/6] add state --- lsp/rescriptlsp.ml | 67 ++++++++++++++++++++++++++++------------------ lsp/state.ml | 22 +++++++++++++++ 2 files changed, 63 insertions(+), 26 deletions(-) create mode 100644 lsp/state.ml diff --git a/lsp/rescriptlsp.ml b/lsp/rescriptlsp.ml index 57d66f16f7d..bebf1407132 100644 --- a/lsp/rescriptlsp.ml +++ b/lsp/rescriptlsp.ml @@ -105,34 +105,37 @@ let notification_of_jsonrpc notification = let respond channel response = Io.await @@ Lsp_Io.write channel @@ Response response -let rec input_loop ~input with_ = +let rec input_loop ~input ~state with_ = match Io.await @@ Lsp_Io.read input with | Some packet -> - let () = with_ packet in - input_loop ~input with_ + let state = with_ state packet in + input_loop ~input ~state with_ | exception exn -> raise exn | None -> () -let listen ~input ~output ~on_request ~on_notification = - let handle_request channel request = - respond channel (on_request channel request) +let listen ~input ~output ~on_request ~on_notification ~state = + let handle_request state channel request = + let response, state = on_request state channel request in + respond channel response; + state in - let handle_notification channel notification = - on_notification channel (notification_of_jsonrpc notification) + let handle_notification state channel notification = + on_notification state channel (notification_of_jsonrpc notification) in let input = Chan.of_source input in Chan.with_sink output @@ fun channel -> - input_loop ~input @@ fun packet -> + input_loop ~input ~state @@ fun state packet -> match packet with - | Notification notification -> handle_notification channel notification - | Request request -> handle_request channel request + | Notification notification -> handle_notification state channel notification + | Request request -> handle_request state channel request | Batch_call calls -> - List.iter - (fun call -> + List.fold_left + (fun state call -> match call with - | `Request request -> handle_request channel request - | `Notification notification -> handle_notification channel notification) - calls + | `Request request -> handle_request state channel request + | `Notification notification -> + handle_notification state channel notification) + state calls | Response _ -> raise (Lsp.Io.Error "unexpected response") | Batch_response _ -> raise (Lsp.Io.Error "unexpected batch response") @@ -149,12 +152,14 @@ let initialization = ServerCapabilities.create ~textDocumentSync ~hoverProvider:(`Bool true) () in let serverInfo = - let version = "experimental" in - InitializeResult.create_serverInfo ~name:"rescriptlsp" ~version () + let version = "2.0.0-aplha.1" in + InitializeResult.create_serverInfo ~name:"rescript-language-server" ~version + () in InitializeResult.create ~capabilities ~serverInfo () -let on_request _channel (jsonrpc_request : Jsonrpc.Request.t) : Jsonrpc.Response.t = +let on_request state _channel (jsonrpc_request : Jsonrpc.Request.t) : + Jsonrpc.Response.t * State.t = let result = let (E request) = request_of_jsonrpc jsonrpc_request in match request with @@ -167,22 +172,32 @@ let on_request _channel (jsonrpc_request : Jsonrpc.Request.t) : Jsonrpc.Response Error (Jsonrpc.Response.Error.make ~code:Jsonrpc.Response.Error.Code.MethodNotFound - ~message:"Method not supported" ()) + ~message:("Method not supported " ^ jsonrpc_request.method_) + ()) in - Jsonrpc.Response.{id = jsonrpc_request.id; result} + (Jsonrpc.Response.{id = jsonrpc_request.id; result}, state) -let on_notification _channel notification = +let on_notification state _channel notification = match notification with - | Lsp.Client_notification.Initialized -> () - | TextDocumentDidOpen _ -> () - | TextDocumentDidChange _ -> () + | Lsp.Client_notification.Initialized -> state + | TextDocumentDidOpen {textDocument = {uri; text; version; _}} -> + State.open_document state ~uri ~text ~version + | TextDocumentDidChange {textDocument = {uri; version; _}; contentChanges} + -> ( + match List.rev contentChanges with + | {text; _} :: _ -> State.update_document state ~uri ~text ~version + | [] -> state) + | TextDocumentDidClose {textDocument = {uri; _}} -> + (* let uri = Lsp.Uri.to_string textDocument.uri in *) + State.close_document state ~uri | Exit -> exit 0 - | _ -> () + | _ -> state let main () = Eio_main.run @@ fun env -> let stdin = Eio.Stdenv.stdin env in let stdout = Eio.Stdenv.stdout env in listen ~input:stdin ~output:stdout ~on_request ~on_notification + ~state:State.empty let () = main () diff --git a/lsp/state.ml b/lsp/state.ml new file mode 100644 index 00000000000..70c61190339 --- /dev/null +++ b/lsp/state.ml @@ -0,0 +1,22 @@ +module UriMap = Map.Make (Lsp.Uri) + +type document = { + text : string; + version : int; +} + +type t = { + documents : document UriMap.t; + diagnostics : Lsp.Types.Diagnostic.t list UriMap.t; +} + +let empty = {documents = UriMap.empty; diagnostics = UriMap.empty} + +let open_document t ~uri ~text ~version = + {t with documents = UriMap.add uri {text; version} t.documents} + +let update_document t ~uri ~text ~version = + {t with documents = UriMap.add uri {text; version} t.documents} + +let close_document t ~uri = + {t with documents = UriMap.remove uri t.documents} From e2989d0395db9379309cb87ad79cb7997e723348 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Mon, 11 May 2026 22:02:11 -0300 Subject: [PATCH 4/6] Extract server I/O into Server module and simplify handlers - Move Io, Chan, and listen infrastructure to server.ml - Simplify on_request to take a packed request directly - Add basic hover response with markdown content - Rename public executable to rescript-language-server --- lsp/dune | 2 +- lsp/rescriptlsp.ml | 182 ++++++--------------------------------------- lsp/server.ml | 143 +++++++++++++++++++++++++++++++++++ 3 files changed, 166 insertions(+), 161 deletions(-) create mode 100644 lsp/server.ml diff --git a/lsp/dune b/lsp/dune index ec167bdd89c..f712c3b6e46 100644 --- a/lsp/dune +++ b/lsp/dune @@ -1,5 +1,5 @@ (executable (name rescriptlsp) (package rescript-lsp) - (public_name rescript-lsp) + (public_name rescript-language-server) (libraries lsp eio eio_main)) diff --git a/lsp/rescriptlsp.ml b/lsp/rescriptlsp.ml index bebf1407132..a95dbb5a98c 100644 --- a/lsp/rescriptlsp.ml +++ b/lsp/rescriptlsp.ml @@ -1,144 +1,3 @@ -module Io : sig - type 'a t - - val return : 'a -> 'a t - val raise : exn -> 'a t - val await : 'a t -> 'a - val async : (sw:Eio.Switch.t -> ('a, exn) result) -> 'a t - - module O : sig - val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t - val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t - end -end = struct - type 'a t = sw:Eio.Switch.t -> ('a, exn) result Eio.Promise.t - - let await t = Eio.Switch.run @@ fun sw -> Eio.Promise.await_exn (t ~sw) - let return value ~sw:_ = Eio.Promise.create_resolved (Ok value) - let error desc ~sw:_ = Eio.Promise.create_resolved (Error desc) - - let async f ~sw = - let promise, resolver = Eio.Promise.create () in - ( Eio.Fiber.fork ~sw @@ fun () -> - try - let result = f ~sw in - Eio.Promise.resolve resolver result - with exn -> Eio.Promise.resolve resolver @@ Error exn ); - promise - - let bind t f = - async @@ fun ~sw -> - match Eio.Promise.await (t ~sw) with - | Ok value -> Eio.Promise.await @@ f value ~sw - | Error desc -> Error desc - - let raise = error - - module O = struct - let ( let+ ) x f = bind x @@ fun value -> return @@ f value - let ( let* ) = bind - end -end - -module Chan : sig - type input - type output - - val of_source : [> Eio__Flow.source_ty] Eio.Resource.t -> input - val with_sink : [> Eio__Flow.sink_ty] Eio.Resource.t -> (output -> 'a) -> 'a - - val read_line : input -> string option Io.t - val read_exactly : input -> int -> string option Io.t - val write : output -> string list -> unit Io.t -end = struct - type input = {mutex: Eio.Mutex.t; buf: Eio.Buf_read.t} - type output = {mutex: Eio.Mutex.t; buf: Eio.Buf_write.t} - - let initial_size = 1024 - let max_size = 1024 * 1024 - - let of_source source : input = - let mutex = Eio.Mutex.create () in - let buf = Eio.Buf_read.of_flow ~initial_size ~max_size source in - {mutex; buf} - - let with_sink sink f = - let mutex = Eio.Mutex.create () in - Eio.Buf_write.with_flow ~initial_size sink @@ fun buf -> f {mutex; buf} - - let read_line (input : input) = - Io.async @@ fun ~sw:_ -> - Eio.Mutex.use_rw ~protect:true input.mutex @@ fun () -> - if Eio.Buf_read.eof_seen input.buf then Ok None - else - match Eio.Buf_read.line input.buf with - | line -> Ok (Some line) - | exception End_of_file -> Ok None - - let read_exactly (input : input) size = - Io.async @@ fun ~sw:_ -> - Eio.Mutex.use_rw ~protect:true input.mutex @@ fun () -> - if Eio.Buf_read.eof_seen input.buf then Ok None - else - match Eio.Buf_read.take size input.buf with - | data -> Ok (Some data) - | exception End_of_file -> Ok None - - let write (output : output) (str : string list) = - Io.async @@ fun ~sw:_ -> - Eio.Mutex.use_rw ~protect:true output.mutex @@ fun () -> - Ok (List.iter (Eio.Buf_write.string output.buf) str) -end - -module Lsp_Io = Lsp.Io.Make (Io) (Chan) - -let request_of_jsonrpc request = - match Lsp.Client_request.of_jsonrpc request with - | Ok request -> request - | Error error -> raise (Lsp.Io.Error error) - -let notification_of_jsonrpc notification = - match Lsp.Client_notification.of_jsonrpc notification with - | Ok notification -> notification - | Error error -> raise (Lsp.Io.Error error) - -let respond channel response = - Io.await @@ Lsp_Io.write channel @@ Response response - -let rec input_loop ~input ~state with_ = - match Io.await @@ Lsp_Io.read input with - | Some packet -> - let state = with_ state packet in - input_loop ~input ~state with_ - | exception exn -> raise exn - | None -> () - -let listen ~input ~output ~on_request ~on_notification ~state = - let handle_request state channel request = - let response, state = on_request state channel request in - respond channel response; - state - in - let handle_notification state channel notification = - on_notification state channel (notification_of_jsonrpc notification) - in - let input = Chan.of_source input in - Chan.with_sink output @@ fun channel -> - input_loop ~input ~state @@ fun state packet -> - match packet with - | Notification notification -> handle_notification state channel notification - | Request request -> handle_request state channel request - | Batch_call calls -> - List.fold_left - (fun state call -> - match call with - | `Request request -> handle_request state channel request - | `Notification notification -> - handle_notification state channel notification) - state calls - | Response _ -> raise (Lsp.Io.Error "unexpected response") - | Batch_response _ -> raise (Lsp.Io.Error "unexpected batch response") - let initialization = let open Lsp.Types in let textDocumentSync = @@ -158,24 +17,27 @@ let initialization = in InitializeResult.create ~capabilities ~serverInfo () -let on_request state _channel (jsonrpc_request : Jsonrpc.Request.t) : - Jsonrpc.Response.t * State.t = - let result = - let (E request) = request_of_jsonrpc jsonrpc_request in - match request with - | Lsp.Client_request.Initialize _ -> - Ok (Lsp.Client_request.yojson_of_result request initialization) - | Shutdown -> Ok (Lsp.Client_request.yojson_of_result request ()) - | TextDocumentHover _ -> - Ok (Lsp.Client_request.yojson_of_result request None) - | _ -> - Error - (Jsonrpc.Response.Error.make - ~code:Jsonrpc.Response.Error.Code.MethodNotFound - ~message:("Method not supported " ^ jsonrpc_request.method_) - ()) - in - (Jsonrpc.Response.{id = jsonrpc_request.id; result}, state) +let on_request (Lsp.Client_request.E request) = + let open Lsp.Types in + let ok value = Ok (Lsp.Client_request.yojson_of_result request value) in + match request with + | Lsp.Client_request.Initialize _ -> ok initialization + | Shutdown -> ok () + | TextDocumentHover _ -> + let hover = + Lsp.Types.Hover.create + ~contents: + (`MarkupContent + (MarkupContent.create ~kind:MarkupKind.Markdown + ~value:"# Hover working!!!")) + () + in + ok (Some hover) + | _ -> + Error + (Jsonrpc.Response.Error.make + ~code:Jsonrpc.Response.Error.Code.MethodNotFound + ~message:"Request method not supported" ()) let on_notification state _channel notification = match notification with @@ -197,7 +59,7 @@ let main () = Eio_main.run @@ fun env -> let stdin = Eio.Stdenv.stdin env in let stdout = Eio.Stdenv.stdout env in - listen ~input:stdin ~output:stdout ~on_request ~on_notification + Server.listen ~input:stdin ~output:stdout ~on_request ~on_notification ~state:State.empty let () = main () diff --git a/lsp/server.ml b/lsp/server.ml new file mode 100644 index 00000000000..c71f7a23218 --- /dev/null +++ b/lsp/server.ml @@ -0,0 +1,143 @@ +module Io : sig + type 'a t + + val return : 'a -> 'a t + val raise : exn -> 'a t + val await : 'a t -> 'a + val async : (sw:Eio.Switch.t -> ('a, exn) result) -> 'a t + + module O : sig + val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t + val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t + end +end = struct + type 'a t = sw:Eio.Switch.t -> ('a, exn) result Eio.Promise.t + + let await t = Eio.Switch.run @@ fun sw -> Eio.Promise.await_exn (t ~sw) + let return value ~sw:_ = Eio.Promise.create_resolved (Ok value) + let error desc ~sw:_ = Eio.Promise.create_resolved (Error desc) + + let async f ~sw = + let promise, resolver = Eio.Promise.create () in + ( Eio.Fiber.fork ~sw @@ fun () -> + try + let result = f ~sw in + Eio.Promise.resolve resolver result + with exn -> Eio.Promise.resolve resolver @@ Error exn ); + promise + + let bind t f = + async @@ fun ~sw -> + match Eio.Promise.await (t ~sw) with + | Ok value -> Eio.Promise.await @@ f value ~sw + | Error desc -> Error desc + + let raise = error + + module O = struct + let ( let+ ) x f = bind x @@ fun value -> return @@ f value + let ( let* ) = bind + end +end + +module Chan : sig + type input + type output + + val of_source : [> Eio__Flow.source_ty] Eio.Resource.t -> input + val with_sink : [> Eio__Flow.sink_ty] Eio.Resource.t -> (output -> 'a) -> 'a + + val read_line : input -> string option Io.t + val read_exactly : input -> int -> string option Io.t + val write : output -> string list -> unit Io.t +end = struct + type input = {mutex: Eio.Mutex.t; buf: Eio.Buf_read.t} + type output = {mutex: Eio.Mutex.t; buf: Eio.Buf_write.t} + + let initial_size = 1024 + let max_size = 1024 * 1024 + + let of_source source : input = + let mutex = Eio.Mutex.create () in + let buf = Eio.Buf_read.of_flow ~initial_size ~max_size source in + {mutex; buf} + + let with_sink sink f = + let mutex = Eio.Mutex.create () in + Eio.Buf_write.with_flow ~initial_size sink @@ fun buf -> f {mutex; buf} + + let read_line (input : input) = + Io.async @@ fun ~sw:_ -> + Eio.Mutex.use_rw ~protect:true input.mutex @@ fun () -> + if Eio.Buf_read.eof_seen input.buf then Ok None + else + match Eio.Buf_read.line input.buf with + | line -> Ok (Some line) + | exception End_of_file -> Ok None + + let read_exactly (input : input) size = + Io.async @@ fun ~sw:_ -> + Eio.Mutex.use_rw ~protect:true input.mutex @@ fun () -> + if Eio.Buf_read.eof_seen input.buf then Ok None + else + match Eio.Buf_read.take size input.buf with + | data -> Ok (Some data) + | exception End_of_file -> Ok None + + let write (output : output) (str : string list) = + Io.async @@ fun ~sw:_ -> + Eio.Mutex.use_rw ~protect:true output.mutex @@ fun () -> + Ok (List.iter (Eio.Buf_write.string output.buf) str) +end + +module Lsp_Io = Lsp.Io.Make (Io) (Chan) + +let notification_of_jsonrpc notification = + match Lsp.Client_notification.of_jsonrpc notification with + | Ok notification -> notification + | Error error -> raise (Lsp.Io.Error error) + +let respond channel response = + Io.await @@ Lsp_Io.write channel @@ Response response + +let rec input_loop ~input ~state with_ = + match Io.await @@ Lsp_Io.read input with + | Some packet -> + let state = with_ state packet in + input_loop ~input ~state with_ + | exception exn -> raise exn + | None -> () + +let listen ~input ~output ~on_request ~on_notification ~state = + let handle_request state channel request = + let response = + match Lsp.Client_request.of_jsonrpc request with + | Error message -> + let code = Jsonrpc.Response.Error.Code.InvalidParams in + let err = Jsonrpc.Response.Error.make ~code ~message () in + Jsonrpc.Response.{id = request.id; result = Error err} + | Ok packed -> + Jsonrpc.Response.{id = request.id; result = on_request packed} + in + respond channel response; + state + in + let handle_notification state channel notification = + on_notification state channel (notification_of_jsonrpc notification) + in + let input = Chan.of_source input in + Chan.with_sink output @@ fun channel -> + input_loop ~input ~state @@ fun state packet -> + match packet with + | Notification notification -> handle_notification state channel notification + | Request request -> handle_request state channel request + | Batch_call calls -> + List.fold_left + (fun state call -> + match call with + | `Request request -> handle_request state channel request + | `Notification notification -> + handle_notification state channel notification) + state calls + | Response _ -> raise (Lsp.Io.Error "unexpected response") + | Batch_response _ -> raise (Lsp.Io.Error "unexpected batch response") From a99abc674d099b1ffc4b270f169600c1f3628819 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Tue, 12 May 2026 15:49:00 -0300 Subject: [PATCH 5/6] Add parse_implementation_from_source and refactor LSP server - Add `parse_implementation_from_source` to parsing/print engine types and all engine implementations, enabling parsing from a string source rather than a filename - Use `parse_implementation_from_source` in CompletionFrontEnd - Rename package from `rescript-lsp` to `rescript-language-server` - Refactor LSP server with typed state, document store, and diagnostics - Add hover support via completion backend integration --- analysis/src/CompletionFrontEnd.ml | 5 +- compiler/syntax/src/res_ast_debugger.ml | 11 ++ compiler/syntax/src/res_driver.ml | 33 ++++ compiler/syntax/src/res_driver.mli | 10 ++ compiler/syntax/src/res_driver_binary.ml | 5 + compiler/syntax/src/res_driver_ml_printer.ml | 3 + compiler/syntax/src/res_token_debugger.ml | 2 + dune-project | 12 +- lsp/diagnostics.ml | 5 + lsp/document_store.ml | 30 ++++ lsp/dune | 8 +- lsp/hover.ml | 142 ++++++++++++++++++ lsp/rescript_language_server.ml | 84 +++++++++++ lsp/rescriptlsp.ml | 65 -------- lsp/server.ml | 41 +++-- lsp/state.ml | 27 ++-- ...-lsp.opam => rescript-language-server.opam | 4 +- 17 files changed, 380 insertions(+), 107 deletions(-) create mode 100644 lsp/diagnostics.ml create mode 100644 lsp/document_store.ml create mode 100644 lsp/hover.ml create mode 100644 lsp/rescript_language_server.ml delete mode 100644 lsp/rescriptlsp.ml rename rescript-lsp.opam => rescript-language-server.opam (90%) diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml index a5c0f9ce377..cba2cbfad1a 100644 --- a/analysis/src/CompletionFrontEnd.ml +++ b/analysis/src/CompletionFrontEnd.ml @@ -1785,9 +1785,10 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor if Filename.check_suffix path ".res" then ( let parser = - Res_driver.parsing_engine.parse_implementation ~for_printer:false + Res_driver.parsing_engine.parse_implementation_from_source + ~for_printer:false in - let {Res_driver.parsetree = str} = parser ~filename:currentFile in + let {Res_driver.parsetree = str} = parser ~source:currentFile in iterator.structure iterator str |> ignore; if blankAfterCursor = Some ' ' || blankAfterCursor = Some '\n' then ( scope := !lastScopeBeforeCursor; diff --git a/compiler/syntax/src/res_ast_debugger.ml b/compiler/syntax/src/res_ast_debugger.ml index 5b3e5ecf01e..cabd950235c 100644 --- a/compiler/syntax/src/res_ast_debugger.ml +++ b/compiler/syntax/src/res_ast_debugger.ml @@ -7,6 +7,9 @@ let print_engine = print_implementation = (fun ~width:_ ~filename:_ ~comments:_ structure -> Printast.implementation Format.std_formatter structure); + parse_implementation_from_source = + (fun ~width:_ ~source:_ ~comments:_ structure -> + Printast.implementation Format.std_formatter structure); print_interface = (fun ~width:_ ~filename:_ ~comments:_ signature -> Printast.interface Format.std_formatter signature); @@ -962,6 +965,9 @@ module SexpAst = struct print_implementation = (fun ~width:_ ~filename:_ ~comments:_ parsetree -> parsetree |> structure |> Sexp.to_string |> print_string); + parse_implementation_from_source = + (fun ~width:_ ~source:_ ~comments:_ parsetree -> + parsetree |> structure |> Sexp.to_string |> print_string); print_interface = (fun ~width:_ ~filename:_ ~comments:_ parsetree -> parsetree |> signature |> Sexp.to_string |> print_string); @@ -977,6 +983,11 @@ let comments_print_engine = let cmt_tbl = CommentTable.make () in CommentTable.walk_structure s cmt_tbl comments; CommentTable.log cmt_tbl); + Res_driver.parse_implementation_from_source = + (fun ~width:_ ~source:_ ~comments s -> + let cmt_tbl = CommentTable.make () in + CommentTable.walk_structure s cmt_tbl comments; + CommentTable.log cmt_tbl); print_interface = (fun ~width:_ ~filename:_ ~comments s -> let cmt_tbl = CommentTable.make () in diff --git a/compiler/syntax/src/res_driver.ml b/compiler/syntax/src/res_driver.ml index 64039e76560..5a8d07ab593 100644 --- a/compiler/syntax/src/res_driver.ml +++ b/compiler/syntax/src/res_driver.ml @@ -14,6 +14,10 @@ type 'diagnostics parsing_engine = { for_printer:bool -> filename:string -> (Parsetree.structure, 'diagnostics) parse_result; + parse_implementation_from_source: + for_printer:bool -> + source:string -> + (Parsetree.structure, 'diagnostics) parse_result; parse_interface: for_printer:bool -> filename:string -> @@ -29,6 +33,12 @@ type print_engine = { comments:Res_comment.t list -> Parsetree.structure -> unit; + parse_implementation_from_source: + width:int -> + source:string -> + comments:Res_comment.t list -> + Parsetree.structure -> + unit; print_interface: width:int -> filename:string -> @@ -65,6 +75,25 @@ let parsing_engine = invalid; comments = List.rev engine.comments; }); + parse_implementation_from_source = + (fun ~for_printer ~source -> + let engine = + setup_from_source ~source ~for_printer ~display_filename:"source" () + in + let structure = Res_core.parse_implementation engine in + let invalid, diagnostics = + match engine.diagnostics with + | [] as diagnostics -> (false, diagnostics) + | _ as diagnostics -> (true, diagnostics) + in + { + filename = engine.scanner.filename; + source = engine.scanner.src; + parsetree = structure; + diagnostics; + invalid; + comments = List.rev engine.comments; + }); parse_interface = (fun ~for_printer ~filename -> let engine = setup ~filename ~for_printer () in @@ -127,6 +156,10 @@ let print_engine = (fun ~width ~filename:_ ~comments structure -> print_string (Res_printer.print_implementation ~width structure ~comments)); + parse_implementation_from_source = + (fun ~width ~source:_ ~comments structure -> + print_string + (Res_printer.print_implementation ~width structure ~comments)); print_interface = (fun ~width ~filename:_ ~comments signature -> print_string (Res_printer.print_interface ~width signature ~comments)); diff --git a/compiler/syntax/src/res_driver.mli b/compiler/syntax/src/res_driver.mli index 2b717013ccb..8546224b395 100644 --- a/compiler/syntax/src/res_driver.mli +++ b/compiler/syntax/src/res_driver.mli @@ -12,6 +12,10 @@ type 'diagnostics parsing_engine = { for_printer:bool -> filename:string -> (Parsetree.structure, 'diagnostics) parse_result; + parse_implementation_from_source: + for_printer:bool -> + source:string -> + (Parsetree.structure, 'diagnostics) parse_result; parse_interface: for_printer:bool -> filename:string -> @@ -41,6 +45,12 @@ type print_engine = { comments:Res_comment.t list -> Parsetree.structure -> unit; + parse_implementation_from_source: + width:int -> + source:string -> + comments:Res_comment.t list -> + Parsetree.structure -> + unit; print_interface: width:int -> filename:string -> diff --git a/compiler/syntax/src/res_driver_binary.ml b/compiler/syntax/src/res_driver_binary.ml index 71eb12bd483..59ce51c7165 100644 --- a/compiler/syntax/src/res_driver_binary.ml +++ b/compiler/syntax/src/res_driver_binary.ml @@ -6,6 +6,11 @@ let print_engine = output_string stdout Config.ast_impl_magic_number; output_value stdout filename; output_value stdout structure); + parse_implementation_from_source = + (fun ~width:_ ~source:_ ~comments:_ structure -> + output_string stdout Config.ast_impl_magic_number; + output_value stdout "source"; + output_value stdout structure); print_interface = (fun ~width:_ ~filename ~comments:_ signature -> output_string stdout Config.ast_intf_magic_number; diff --git a/compiler/syntax/src/res_driver_ml_printer.ml b/compiler/syntax/src/res_driver_ml_printer.ml index 651ab058402..dd94a9e9611 100644 --- a/compiler/syntax/src/res_driver_ml_printer.ml +++ b/compiler/syntax/src/res_driver_ml_printer.ml @@ -4,6 +4,9 @@ let print_engine = print_implementation = (fun ~width:_ ~filename:_ ~comments:_ structure -> Pprintast.structure Format.std_formatter structure); + parse_implementation_from_source = + (fun ~width:_ ~source:_ ~comments:_ structure -> + Pprintast.structure Format.std_formatter structure); print_interface = (fun ~width:_ ~filename:_ ~comments:_ signature -> Pprintast.signature Format.std_formatter signature); diff --git a/compiler/syntax/src/res_token_debugger.ml b/compiler/syntax/src/res_token_debugger.ml index e745308dd4f..387beb15a8f 100644 --- a/compiler/syntax/src/res_token_debugger.ml +++ b/compiler/syntax/src/res_token_debugger.ml @@ -142,6 +142,8 @@ let token_print_engine = { Res_driver.print_implementation = (fun ~width:_ ~filename ~comments:_ _ -> dump_tokens filename); + Res_driver.parse_implementation_from_source = + (fun ~width:_ ~source:filename ~comments:_ _ -> dump_tokens filename); print_interface = (fun ~width:_ ~filename ~comments:_ _ -> dump_tokens filename); } diff --git a/dune-project b/dune-project index 3c7aa9fdbfc..a194bdaa462 100644 --- a/dune-project +++ b/dune-project @@ -19,7 +19,8 @@ (synopsis "ReScript compiler") (depends (ocaml - (>= 5.0.0)))) + (>= 5.0.0)) + (ocaml-lsp-server (and (>= 1.26.0) :with-test-setup)))) (package (name analysis) @@ -45,11 +46,16 @@ dune)) (package - (name rescript-lsp) + (name rescript-language-server) (synopsis "ReScript LSP") (depends (ocaml (>= 4.10)) + (lsp + (>= 1.22.0)) + (eio + (>= 1.3)) + (eio_main + (>= 1.3)) analysis - lsp dune)) diff --git a/lsp/diagnostics.ml b/lsp/diagnostics.ml new file mode 100644 index 00000000000..de172eda24b --- /dev/null +++ b/lsp/diagnostics.ml @@ -0,0 +1,5 @@ +module UriMap = Map.Make (Lsp.Uri) + +type t = Lsp.Types.Diagnostic.t list UriMap.t + +let create () = UriMap.empty diff --git a/lsp/document_store.ml b/lsp/document_store.ml new file mode 100644 index 00000000000..d818d61f60d --- /dev/null +++ b/lsp/document_store.ml @@ -0,0 +1,30 @@ +(* module UriMap = Map.Make (Lsp.Uri) *) + +type document = {text: string; version: int} + +type t = {documents: (Lsp.Uri.t, document) Hashtbl.t} + +let create () = {documents = Hashtbl.create 25} + +let open_document t ~uri ~text ~version = + Hashtbl.add t.documents uri {text; version}; + t + +let update_document t ~uri ~text ~version = + (match Hashtbl.find_opt t.documents uri with + | None -> + raise + (Failure (Printf.sprintf "Document not found: %s" (Lsp.Uri.to_string uri))) + | Some _ -> Hashtbl.replace t.documents uri {text; version}); + t + +let remove_document t ~uri = + Hashtbl.remove t.documents uri; + t + +let get_document t ~uri = + match Hashtbl.find_opt t.documents uri with + | Some doc -> doc + | None -> + raise + (Failure (Printf.sprintf "Document not found: %s" (Lsp.Uri.to_string uri))) diff --git a/lsp/dune b/lsp/dune index f712c3b6e46..16392a1b453 100644 --- a/lsp/dune +++ b/lsp/dune @@ -1,5 +1,7 @@ (executable - (name rescriptlsp) - (package rescript-lsp) + (name rescript_language_server) + (package rescript-language-server) (public_name rescript-language-server) - (libraries lsp eio eio_main)) + (libraries lsp eio eio_main analysis) + (flags + (-w "-9"))) diff --git a/lsp/hover.ml b/lsp/hover.ml new file mode 100644 index 00000000000..c8290be4321 --- /dev/null +++ b/lsp/hover.ml @@ -0,0 +1,142 @@ +open Lsp.Types + +let getCompletions ~debug ~path ~pos ~currentFile ~forHover = + let textOpt = Some currentFile in + match textOpt with + | None | Some "" -> None + | Some text -> ( + match + Analysis.CompletionFrontEnd.completionWithParser ~debug ~path + ~posCursor:pos ~currentFile ~text + with + | None -> None + | Some (completable, scope) -> ( + (* uncomment when debugging *) + if false then ( + Printf.printf "\nScope from frontend:\n"; + List.iter + (fun item -> + Printf.printf "%s\n" + (Analysis.SharedTypes.ScopeTypes.item_to_string item)) + scope; + print_newline ()); + (* Only perform expensive ast operations if there are completables *) + match Analysis.Cmt.loadFullCmtFromPath ~path with + | None -> None + | Some full -> + let env = Analysis.SharedTypes.QueryEnv.fromFile full.file in + let completables = + completable + |> Analysis.CompletionBackEnd.processCompletable ~debug ~full ~pos + ~scope ~env ~forHover + in + Some (completables, full, scope))) + +(* Leverages autocomplete functionality to produce a hover for a position. This + makes it (most often) work with unsaved content. *) +let getHoverViaCompletions ~debug ~path ~pos ~currentFile ~forHover + ~supportsMarkdownLinks = + match getCompletions ~debug ~path ~pos ~currentFile ~forHover with + | None -> None + | Some (completions, ({file; package} as full), scope) -> ( + let rawOpens = Analysis.Scope.getRawOpens scope in + match completions with + | {kind = Label typString; docstring} :: _ -> + let parts = + docstring + @ if typString = "" then [] else [Analysis.Markdown.codeBlock typString] + in + + Some (String.concat "\n\n" parts) + | {kind = Field _; env; docstring} :: _ -> ( + let opens = + Analysis.CompletionBackEnd.getOpens ~debug ~rawOpens ~package ~env + in + match + Analysis.CompletionBackEnd.completionsGetTypeEnv2 ~debug ~full ~rawOpens + ~opens ~pos completions + with + | Some (typ, _env) -> + let typeString = + Analysis.Hover.hoverWithExpandedTypes ~file ~package ~docstring + ~supportsMarkdownLinks typ + in + Some typeString + | None -> None) + | {env} :: _ -> ( + let opens = + Analysis.CompletionBackEnd.getOpens ~debug ~rawOpens ~package ~env + in + match + Analysis.CompletionBackEnd.completionsGetTypeEnv2 ~debug ~full ~rawOpens + ~opens ~pos completions + with + | Some (typ, _env) -> + let typeString = + Analysis.Hover.hoverWithExpandedTypes ~file ~package + ~supportsMarkdownLinks typ + in + Some typeString + | None -> None) + | _ -> None) + +let create ~(position : Position.t) ~(uri : DocumentUri.t) + ~(current_file : string) = + let path = DocumentUri.to_path uri in + let pos = (position.line, position.character) in + let supportsMarkdownLinks = true in + let currentFile = current_file in + let debug = false in + + let result = + try + match Analysis.Cmt.loadFullCmtFromPath ~path with + | None -> None + | Some full -> ( + match Analysis.References.getLocItem ~full ~pos ~debug with + | None -> + getHoverViaCompletions ~debug ~path ~pos ~currentFile ~forHover:true + ~supportsMarkdownLinks:false + | Some locItem -> + let isModule = + match locItem.locType with + | LModule _ | TopLevelModule _ -> true + | TypeDefinition _ | Typed _ | Constant _ -> false + in + let uriLocOpt = + Analysis.References.definitionForLocItem ~full locItem + in + let skipZero = + match uriLocOpt with + | None -> false + | Some (_, loc) -> + let isInterface = full.file.uri |> Analysis.Uri.isInterface in + let posIsZero {Lexing.pos_lnum; pos_bol; pos_cnum} = + (not isInterface) && pos_lnum = 1 && pos_cnum - pos_bol = 0 + in + (* Skip if range is all zero, unless it's a module *) + (not isModule) && posIsZero loc.loc_start && posIsZero loc.loc_end + in + if skipZero then None + else Analysis.Hover.newHover ~supportsMarkdownLinks ~full locItem) + with + | Not_found -> Some "Not found" + | Failure msg -> Some "Failure" + | exp -> Some (Printexc.to_string exp) + in + + match result with + | None -> + Some + (Hover.create + ~contents: + (`MarkupContent + (MarkupContent.create ~kind:MarkupKind.Markdown ~value:"None")) + ()) + | Some value -> + Some + (Hover.create + ~contents: + (`MarkupContent + (MarkupContent.create ~kind:MarkupKind.Markdown ~value)) + ()) diff --git a/lsp/rescript_language_server.ml b/lsp/rescript_language_server.ml new file mode 100644 index 00000000000..62ae1aadebb --- /dev/null +++ b/lsp/rescript_language_server.ml @@ -0,0 +1,84 @@ +let initialization (client_capabilities : Lsp.Types.ClientCapabilities.t) = + let open Lsp.Types in + let textDocumentSync = + `TextDocumentSyncOptions + (TextDocumentSyncOptions.create ~openClose:true + ~change:TextDocumentSyncKind.Full ~willSave:false + ~save:(`SaveOptions (SaveOptions.create ~includeText:false ())) + ~willSaveWaitUntil:false ()) + in + let capabilities = + ServerCapabilities.create ~textDocumentSync ~hoverProvider:(`Bool true) () + in + let serverInfo = + let version = "2.0.0-aplha.1" in + InitializeResult.create_serverInfo ~name:"rescript-language-server" ~version + () + in + InitializeResult.create ~capabilities ~serverInfo () + +let show_message server message = + Server.notification server + (Lsp.Server_notification.ShowMessage + (Lsp.Types.ShowMessageParams.create ~type_:Info ~message)) + +let on_initialize (params : Lsp.Types.InitializeParams.t) state = + (* TODO: collect compiler diagnostics and notify client? *) + let diagnostics = Diagnostics.create () in + let initialization_info = initialization params.capabilities in + let state = State.initialize state ~params ~diagnostics in + (initialization_info, state) + +let on_request (Lsp.Client_request.E request) (server : State.t Server.t) = + let state = Server.state server in + let ok value = Ok (Lsp.Client_request.yojson_of_result request value) in + match request with + | Lsp.Client_request.Initialize params -> + let initialization_info, state = on_initialize params state in + (ok initialization_info, state) + | Shutdown -> (ok (), state) + | TextDocumentHover {position; textDocument = {uri}} -> + let current_file = (Document_store.get_document ~uri state.store).text in + show_message server (Lsp.Types.DocumentUri.to_path uri); + let _res = Hover.create ~position ~uri ~current_file in + (ok _res, state) + | _ -> + let err = + Jsonrpc.Response.Error.make + ~code:Jsonrpc.Response.Error.Code.MethodNotFound + ~message:"Request method not supported" () + in + (Error err, state) + +let on_notification notification (server : State.t Server.t) = + let state = Server.state server in + + match notification with + | Lsp.Client_notification.TextDocumentDidOpen + {textDocument = {uri; text; version; _}} -> + let store = Document_store.open_document ~uri ~text ~version state.store in + {state with store} + | TextDocumentDidChange {textDocument = {uri; version; _}; contentChanges} + -> ( + match List.rev contentChanges with + | {text; _} :: _ -> state + | [] -> state) + | TextDocumentDidClose {textDocument = {uri; _}} -> + let store = Document_store.remove_document ~uri state.store in + (* TODO: + * remove state diagnostics + * send updated diagnostics? + *) + + {state with store} + | Exit -> exit 0 + | _ -> state + +let main () = + Eio_main.run @@ fun env -> + let stdin = Eio.Stdenv.stdin env in + let stdout = Eio.Stdenv.stdout env in + Server.listen ~input:stdin ~output:stdout ~on_request ~on_notification + ~state:(State.create ~store:(Document_store.create ())) + +let () = main () diff --git a/lsp/rescriptlsp.ml b/lsp/rescriptlsp.ml deleted file mode 100644 index a95dbb5a98c..00000000000 --- a/lsp/rescriptlsp.ml +++ /dev/null @@ -1,65 +0,0 @@ -let initialization = - let open Lsp.Types in - let textDocumentSync = - `TextDocumentSyncOptions - (TextDocumentSyncOptions.create ~openClose:true - ~change:TextDocumentSyncKind.Full ~willSave:false - ~save:(`SaveOptions (SaveOptions.create ~includeText:false ())) - ~willSaveWaitUntil:false ()) - in - let capabilities = - ServerCapabilities.create ~textDocumentSync ~hoverProvider:(`Bool true) () - in - let serverInfo = - let version = "2.0.0-aplha.1" in - InitializeResult.create_serverInfo ~name:"rescript-language-server" ~version - () - in - InitializeResult.create ~capabilities ~serverInfo () - -let on_request (Lsp.Client_request.E request) = - let open Lsp.Types in - let ok value = Ok (Lsp.Client_request.yojson_of_result request value) in - match request with - | Lsp.Client_request.Initialize _ -> ok initialization - | Shutdown -> ok () - | TextDocumentHover _ -> - let hover = - Lsp.Types.Hover.create - ~contents: - (`MarkupContent - (MarkupContent.create ~kind:MarkupKind.Markdown - ~value:"# Hover working!!!")) - () - in - ok (Some hover) - | _ -> - Error - (Jsonrpc.Response.Error.make - ~code:Jsonrpc.Response.Error.Code.MethodNotFound - ~message:"Request method not supported" ()) - -let on_notification state _channel notification = - match notification with - | Lsp.Client_notification.Initialized -> state - | TextDocumentDidOpen {textDocument = {uri; text; version; _}} -> - State.open_document state ~uri ~text ~version - | TextDocumentDidChange {textDocument = {uri; version; _}; contentChanges} - -> ( - match List.rev contentChanges with - | {text; _} :: _ -> State.update_document state ~uri ~text ~version - | [] -> state) - | TextDocumentDidClose {textDocument = {uri; _}} -> - (* let uri = Lsp.Uri.to_string textDocument.uri in *) - State.close_document state ~uri - | Exit -> exit 0 - | _ -> state - -let main () = - Eio_main.run @@ fun env -> - let stdin = Eio.Stdenv.stdin env in - let stdout = Eio.Stdenv.stdout env in - Server.listen ~input:stdin ~output:stdout ~on_request ~on_notification - ~state:State.empty - -let () = main () diff --git a/lsp/server.ml b/lsp/server.ml index c71f7a23218..0b551fbae2f 100644 --- a/lsp/server.ml +++ b/lsp/server.ml @@ -97,47 +97,58 @@ let notification_of_jsonrpc notification = | Ok notification -> notification | Error error -> raise (Lsp.Io.Error error) -let respond channel response = - Io.await @@ Lsp_Io.write channel @@ Response response +type 'a t = {channel: Chan.output; state: 'a} + +let create ~channel ~state = {channel; state} + +let state t = t.state + +let respond server response = + Io.await @@ Lsp_Io.write server.channel @@ Response response + +let notification server notification = + let notification = Lsp.Server_notification.to_jsonrpc notification in + Io.await @@ Lsp_Io.write server.channel @@ Notification notification let rec input_loop ~input ~state with_ = match Io.await @@ Lsp_Io.read input with | Some packet -> let state = with_ state packet in input_loop ~input ~state with_ - | exception exn -> raise exn + | exception exn -> raise (Failure "Server.input_loop") | None -> () let listen ~input ~output ~on_request ~on_notification ~state = - let handle_request state channel request = - let response = + let handle_request server request = + let response, state = match Lsp.Client_request.of_jsonrpc request with | Error message -> let code = Jsonrpc.Response.Error.Code.InvalidParams in let err = Jsonrpc.Response.Error.make ~code ~message () in - Jsonrpc.Response.{id = request.id; result = Error err} + (Jsonrpc.Response.{id = request.id; result = Error err}, state) | Ok packed -> - Jsonrpc.Response.{id = request.id; result = on_request packed} + let result, state = on_request packed server in + (Jsonrpc.Response.{id = request.id; result}, state) in - respond channel response; + respond server response; state in - let handle_notification state channel notification = - on_notification state channel (notification_of_jsonrpc notification) + let handle_notification server notification = + on_notification (notification_of_jsonrpc notification) server in let input = Chan.of_source input in Chan.with_sink output @@ fun channel -> + let server = create ~channel ~state in input_loop ~input ~state @@ fun state packet -> match packet with - | Notification notification -> handle_notification state channel notification - | Request request -> handle_request state channel request + | Notification notification -> handle_notification server notification + | Request request -> handle_request server request | Batch_call calls -> List.fold_left (fun state call -> match call with - | `Request request -> handle_request state channel request - | `Notification notification -> - handle_notification state channel notification) + | `Request request -> handle_request server request + | `Notification notification -> handle_notification server notification) state calls | Response _ -> raise (Lsp.Io.Error "unexpected response") | Batch_response _ -> raise (Lsp.Io.Error "unexpected batch response") diff --git a/lsp/state.ml b/lsp/state.ml index 70c61190339..e5e87932119 100644 --- a/lsp/state.ml +++ b/lsp/state.ml @@ -1,22 +1,13 @@ -module UriMap = Map.Make (Lsp.Uri) +open Lsp.Types -type document = { - text : string; - version : int; -} +type status = + | Uninitialized + | Initialized of {params: InitializeParams.t; diagnostics: Diagnostics.t} -type t = { - documents : document UriMap.t; - diagnostics : Lsp.Types.Diagnostic.t list UriMap.t; -} +(* TODO: add trace, configuration *) +type t = {status: status; store: Document_store.t} -let empty = {documents = UriMap.empty; diagnostics = UriMap.empty} +let create ~store = {status = Uninitialized; store} -let open_document t ~uri ~text ~version = - {t with documents = UriMap.add uri {text; version} t.documents} - -let update_document t ~uri ~text ~version = - {t with documents = UriMap.add uri {text; version} t.documents} - -let close_document t ~uri = - {t with documents = UriMap.remove uri t.documents} +let initialize t ~params ~diagnostics = + {t with status = Initialized {params; diagnostics}} diff --git a/rescript-lsp.opam b/rescript-language-server.opam similarity index 90% rename from rescript-lsp.opam rename to rescript-language-server.opam index 688d8475282..6b6aa9366a9 100644 --- a/rescript-lsp.opam +++ b/rescript-language-server.opam @@ -8,8 +8,10 @@ homepage: "https://github.com/rescript-lang/rescript-compiler" bug-reports: "https://github.com/rescript-lang/rescript-compiler/issues" depends: [ "ocaml" {>= "4.10"} + "lsp" {>= "1.22.0"} + "eio" {>= "1.3"} + "eio_main" {>= "1.3"} "analysis" - "lsp" "dune" {>= "3.17"} "odoc" {with-doc} ] From 365836c992125c21baa5e2833335e66b2c8c844f Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Thu, 14 May 2026 05:11:41 -0300 Subject: [PATCH 6/6] Split LSP into bin/src layout and add hover integration test Move LSP modules under lsp/src/ with a thin lsp/bin/ entry point, add a configuration module, and introduce a tests/lsp_tests workspace exercising hover end-to-end. --- lsp/bin/dune | 5 + lsp/bin/main.ml | 1 + lsp/bin/main.mli | 0 lsp/src/configuration.ml | 0 lsp/{ => src}/diagnostics.ml | 0 lsp/{ => src}/document_store.ml | 0 lsp/{ => src}/dune | 4 +- lsp/{ => src}/hover.ml | 80 ++--- lsp/{ => src}/rescript_language_server.ml | 43 +-- lsp/{ => src}/server.ml | 43 ++- lsp/{ => src}/state.ml | 0 package.json | 1 + tests/dune | 2 +- tests/lsp_tests/basic-workspace/Hover.res | 286 +++++++++++++++ tests/lsp_tests/basic-workspace/Hover.res.js | 288 +++++++++++++++ tests/lsp_tests/basic-workspace/package.json | 14 + tests/lsp_tests/basic-workspace/rescript.json | 13 + tests/lsp_tests/dune | 9 + tests/lsp_tests/expected/Hover.res.expected | 331 ++++++++++++++++++ tests/lsp_tests/test.ml | 258 ++++++++++++++ yarn.lock | 9 + 21 files changed, 1297 insertions(+), 90 deletions(-) create mode 100644 lsp/bin/dune create mode 100644 lsp/bin/main.ml create mode 100644 lsp/bin/main.mli create mode 100644 lsp/src/configuration.ml rename lsp/{ => src}/diagnostics.ml (100%) rename lsp/{ => src}/document_store.ml (100%) rename lsp/{ => src}/dune (51%) rename lsp/{ => src}/hover.ml (66%) rename lsp/{ => src}/rescript_language_server.ml (69%) rename lsp/{ => src}/server.ml (78%) rename lsp/{ => src}/state.ml (100%) create mode 100644 tests/lsp_tests/basic-workspace/Hover.res create mode 100644 tests/lsp_tests/basic-workspace/Hover.res.js create mode 100644 tests/lsp_tests/basic-workspace/package.json create mode 100644 tests/lsp_tests/basic-workspace/rescript.json create mode 100644 tests/lsp_tests/dune create mode 100644 tests/lsp_tests/expected/Hover.res.expected create mode 100644 tests/lsp_tests/test.ml diff --git a/lsp/bin/dune b/lsp/bin/dune new file mode 100644 index 00000000000..ecd09b26ec7 --- /dev/null +++ b/lsp/bin/dune @@ -0,0 +1,5 @@ +(executable + (name main) + (package rescript-language-server) + (public_name rescript-language-server) + (libraries rescript_language_server)) diff --git a/lsp/bin/main.ml b/lsp/bin/main.ml new file mode 100644 index 00000000000..73ed8920da0 --- /dev/null +++ b/lsp/bin/main.ml @@ -0,0 +1 @@ +let () = Rescript_language_server.main () diff --git a/lsp/bin/main.mli b/lsp/bin/main.mli new file mode 100644 index 00000000000..e69de29bb2d diff --git a/lsp/src/configuration.ml b/lsp/src/configuration.ml new file mode 100644 index 00000000000..e69de29bb2d diff --git a/lsp/diagnostics.ml b/lsp/src/diagnostics.ml similarity index 100% rename from lsp/diagnostics.ml rename to lsp/src/diagnostics.ml diff --git a/lsp/document_store.ml b/lsp/src/document_store.ml similarity index 100% rename from lsp/document_store.ml rename to lsp/src/document_store.ml diff --git a/lsp/dune b/lsp/src/dune similarity index 51% rename from lsp/dune rename to lsp/src/dune index 16392a1b453..486415966af 100644 --- a/lsp/dune +++ b/lsp/src/dune @@ -1,7 +1,5 @@ -(executable +(library (name rescript_language_server) - (package rescript-language-server) - (public_name rescript-language-server) (libraries lsp eio eio_main analysis) (flags (-w "-9"))) diff --git a/lsp/hover.ml b/lsp/src/hover.ml similarity index 66% rename from lsp/hover.ml rename to lsp/src/hover.ml index c8290be4321..4710ec70678 100644 --- a/lsp/hover.ml +++ b/lsp/src/hover.ml @@ -81,58 +81,52 @@ let getHoverViaCompletions ~debug ~path ~pos ~currentFile ~forHover | _ -> None) let create ~(position : Position.t) ~(uri : DocumentUri.t) - ~(current_file : string) = + (server : State.t Server.t) = let path = DocumentUri.to_path uri in let pos = (position.line, position.character) in + + (* NOTE: Should be a config *) let supportsMarkdownLinks = true in - let currentFile = current_file in + + let currentFile = + (Document_store.get_document ~uri server.state.store).text + in let debug = false in let result = - try - match Analysis.Cmt.loadFullCmtFromPath ~path with - | None -> None - | Some full -> ( - match Analysis.References.getLocItem ~full ~pos ~debug with - | None -> - getHoverViaCompletions ~debug ~path ~pos ~currentFile ~forHover:true - ~supportsMarkdownLinks:false - | Some locItem -> - let isModule = - match locItem.locType with - | LModule _ | TopLevelModule _ -> true - | TypeDefinition _ | Typed _ | Constant _ -> false - in - let uriLocOpt = - Analysis.References.definitionForLocItem ~full locItem - in - let skipZero = - match uriLocOpt with - | None -> false - | Some (_, loc) -> - let isInterface = full.file.uri |> Analysis.Uri.isInterface in - let posIsZero {Lexing.pos_lnum; pos_bol; pos_cnum} = - (not isInterface) && pos_lnum = 1 && pos_cnum - pos_bol = 0 - in - (* Skip if range is all zero, unless it's a module *) - (not isModule) && posIsZero loc.loc_start && posIsZero loc.loc_end - in - if skipZero then None - else Analysis.Hover.newHover ~supportsMarkdownLinks ~full locItem) - with - | Not_found -> Some "Not found" - | Failure msg -> Some "Failure" - | exp -> Some (Printexc.to_string exp) + match Analysis.Cmt.loadFullCmtFromPath ~path with + | None -> None + | Some full -> ( + match Analysis.References.getLocItem ~full ~pos ~debug with + | None -> + getHoverViaCompletions ~debug ~path ~pos ~currentFile ~forHover:true + ~supportsMarkdownLinks:false + | Some locItem -> + let isModule = + match locItem.locType with + | LModule _ | TopLevelModule _ -> true + | TypeDefinition _ | Typed _ | Constant _ -> false + in + let uriLocOpt = + Analysis.References.definitionForLocItem ~full locItem + in + let skipZero = + match uriLocOpt with + | None -> false + | Some (_, loc) -> + let isInterface = full.file.uri |> Analysis.Uri.isInterface in + let posIsZero {Lexing.pos_lnum; pos_bol; pos_cnum} = + (not isInterface) && pos_lnum = 1 && pos_cnum - pos_bol = 0 + in + (* Skip if range is all zero, unless it's a module *) + (not isModule) && posIsZero loc.loc_start && posIsZero loc.loc_end + in + if skipZero then None + else Analysis.Hover.newHover ~supportsMarkdownLinks ~full locItem) in match result with - | None -> - Some - (Hover.create - ~contents: - (`MarkupContent - (MarkupContent.create ~kind:MarkupKind.Markdown ~value:"None")) - ()) + | None -> None | Some value -> Some (Hover.create diff --git a/lsp/rescript_language_server.ml b/lsp/src/rescript_language_server.ml similarity index 69% rename from lsp/rescript_language_server.ml rename to lsp/src/rescript_language_server.ml index 62ae1aadebb..b6530ddc481 100644 --- a/lsp/rescript_language_server.ml +++ b/lsp/src/rescript_language_server.ml @@ -17,13 +17,15 @@ let initialization (client_capabilities : Lsp.Types.ClientCapabilities.t) = in InitializeResult.create ~capabilities ~serverInfo () -let show_message server message = - Server.notification server - (Lsp.Server_notification.ShowMessage - (Lsp.Types.ShowMessageParams.create ~type_:Info ~message)) - -let on_initialize (params : Lsp.Types.InitializeParams.t) state = - (* TODO: collect compiler diagnostics and notify client? *) +let on_initialize (params : Lsp.Types.InitializeParams.t) (state : State.t) = + (* TODO: + * Find root project (rescript.json, package.json) using InitializeParams.workspaceFolders and save in State.t + * See https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#initializeParams + * If not found rescript.json kill the server? + * Save initializationOptions in State.t + * This options are: askToStartBuild, codeLens.enable, inlayHints.enable, etc.. + * Collect compiler diagnostics (syntax and type)? + *) let diagnostics = Diagnostics.create () in let initialization_info = initialization params.capabilities in let state = State.initialize state ~params ~diagnostics in @@ -38,10 +40,7 @@ let on_request (Lsp.Client_request.E request) (server : State.t Server.t) = (ok initialization_info, state) | Shutdown -> (ok (), state) | TextDocumentHover {position; textDocument = {uri}} -> - let current_file = (Document_store.get_document ~uri state.store).text in - show_message server (Lsp.Types.DocumentUri.to_path uri); - let _res = Hover.create ~position ~uri ~current_file in - (ok _res, state) + (ok (Hover.create ~position ~uri server), state) | _ -> let err = Jsonrpc.Response.Error.make @@ -58,27 +57,23 @@ let on_notification notification (server : State.t Server.t) = {textDocument = {uri; text; version; _}} -> let store = Document_store.open_document ~uri ~text ~version state.store in {state with store} - | TextDocumentDidChange {textDocument = {uri; version; _}; contentChanges} + (* | TextDocumentDidChange {textDocument = {uri; version; _}; contentChanges} -> ( match List.rev contentChanges with | {text; _} :: _ -> state - | [] -> state) + | [] -> state) *) | TextDocumentDidClose {textDocument = {uri; _}} -> - let store = Document_store.remove_document ~uri state.store in - (* TODO: + (* TODO: * remove state diagnostics * send updated diagnostics? *) - + let store = Document_store.remove_document ~uri state.store in {state with store} - | Exit -> exit 0 + | Exit -> state | _ -> state let main () = - Eio_main.run @@ fun env -> - let stdin = Eio.Stdenv.stdin env in - let stdout = Eio.Stdenv.stdout env in - Server.listen ~input:stdin ~output:stdout ~on_request ~on_notification - ~state:(State.create ~store:(Document_store.create ())) - -let () = main () + Eio_main.run (fun env -> + let state = State.create ~store:(Document_store.create ()) in + Server.listen ~input:env#stdin ~output:env#stdout ~on_request + ~on_notification ~state ~env) diff --git a/lsp/server.ml b/lsp/src/server.ml similarity index 78% rename from lsp/server.ml rename to lsp/src/server.ml index 0b551fbae2f..d2c4edc0977 100644 --- a/lsp/server.ml +++ b/lsp/src/server.ml @@ -97,9 +97,7 @@ let notification_of_jsonrpc notification = | Ok notification -> notification | Error error -> raise (Lsp.Io.Error error) -type 'a t = {channel: Chan.output; state: 'a} - -let create ~channel ~state = {channel; state} +type 'a t = {channel: Chan.output; env: Eio_unix.Stdenv.base; state: 'a} let state t = t.state @@ -110,6 +108,12 @@ let notification server notification = let notification = Lsp.Server_notification.to_jsonrpc notification in Io.await @@ Lsp_Io.write server.channel @@ Notification notification +let log_message_notification ?(kind = Lsp.Types.MessageType.Debug) server + message = + notification server + (Lsp.Server_notification.LogMessage + (Lsp.Types.LogMessageParams.create ~type_:kind ~message)) + let rec input_loop ~input ~state with_ = match Io.await @@ Lsp_Io.read input with | Some packet -> @@ -118,7 +122,7 @@ let rec input_loop ~input ~state with_ = | exception exn -> raise (Failure "Server.input_loop") | None -> () -let listen ~input ~output ~on_request ~on_notification ~state = +let listen ~input ~output ~on_request ~on_notification ~state ~env = let handle_request server request = let response, state = match Lsp.Client_request.of_jsonrpc request with @@ -137,18 +141,19 @@ let listen ~input ~output ~on_request ~on_notification ~state = on_notification (notification_of_jsonrpc notification) server in let input = Chan.of_source input in - Chan.with_sink output @@ fun channel -> - let server = create ~channel ~state in - input_loop ~input ~state @@ fun state packet -> - match packet with - | Notification notification -> handle_notification server notification - | Request request -> handle_request server request - | Batch_call calls -> - List.fold_left - (fun state call -> - match call with - | `Request request -> handle_request server request - | `Notification notification -> handle_notification server notification) - state calls - | Response _ -> raise (Lsp.Io.Error "unexpected response") - | Batch_response _ -> raise (Lsp.Io.Error "unexpected batch response") + Chan.with_sink output (fun channel -> + let server = {channel; state; env} in + input_loop ~input ~state (fun state packet -> + match packet with + | Notification notification -> handle_notification server notification + | Request request -> handle_request server request + | Batch_call calls -> + List.fold_left + (fun state call -> + match call with + | `Request request -> handle_request server request + | `Notification notification -> + handle_notification server notification) + state calls + | Response _ -> raise (Lsp.Io.Error "unexpected response") + | Batch_response _ -> raise (Lsp.Io.Error "unexpected batch response"))) diff --git a/lsp/state.ml b/lsp/src/state.ml similarity index 100% rename from lsp/state.ml rename to lsp/src/state.ml diff --git a/package.json b/package.json index 33bc618206b..7b3de837204 100644 --- a/package.json +++ b/package.json @@ -106,6 +106,7 @@ "tests/tests", "tests/tools_tests", "tests/commonjs_tests", + "tests/lsp_tests/**", "scripts/res" ], "packageManager": "yarn@4.12.0", diff --git a/tests/dune b/tests/dune index 01dd377b945..d9dd6567304 100644 --- a/tests/dune +++ b/tests/dune @@ -1 +1 @@ -(dirs ounit_tests syntax_benchmarks syntax_tests) +(dirs ounit_tests syntax_benchmarks syntax_tests lsp_tests) diff --git a/tests/lsp_tests/basic-workspace/Hover.res b/tests/lsp_tests/basic-workspace/Hover.res new file mode 100644 index 00000000000..230cdafee6e --- /dev/null +++ b/tests/lsp_tests/basic-workspace/Hover.res @@ -0,0 +1,286 @@ +let abc = 22 + 34 +// ^hov + +type t = (int, float) +// ^hov + +module Id = { + // ^hov + type x = int +} + +@ocaml.doc("This module is commented") +module Dep: { + @ocaml.doc("Some doc comment") + let customDouble: int => int +} = { + let customDouble = foo => foo * 2 +} + +module D = Dep +// ^hov + +let cd = D.customDouble +// ^hov + +module HoverInsideModuleWithComponent = { + let x = 2 // check that hover on x works + // ^hov + @react.component + let make = () => React.null +} + +@ocaml.doc("Doc comment for functionWithTypeAnnotation") +let functionWithTypeAnnotation: unit => int = () => 1 +// ^hov + +@react.component +let make = (~name) => React.string(name) +// ^hov + +module C2 = { + @react.component + let make2 = (~name: string) => React.string(name) + // ^hov +} + +let num = 34 +// ^hov + +module type Logger = { + // ^hov + let log: string => unit +} + +module JsLogger: Logger = { + // ^hov + let log = (msg: string) => Console.log(msg) + let _oneMore = 3 +} + +module JJ = JsLogger +// ^def + +module IdDefinedTwice = { + // ^hov + let _x = 10 + let y = 20 + let _x = 10 +} + +module A = { + let x = 13 +} + +module B = A +// ^hov + +module C = B +// ^hov + +module Comp = { + @react.component + let make = (~children: React.element) => children +} + +module Comp1 = Comp + +let _ = + +
+
+ +// ^hov + +let _ = + +
+
+ +// ^hov + +type r<'a> = {i: 'a, f: float} + +let _get = r => r.f +. r.i +// ^hov + +let withAs = (~xx as yyy) => yyy + 1 +// ^hov + +module AA = { + type cond<'a> = [< #str(string)] as 'a + let fnnxx = (b: cond<_>) => true ? b : b +} + +let funAlias = AA.fnnxx + +let typeOk = funAlias +// ^hov + +let typeDuplicate = AA.fnnxx +// ^hov + +@live let dd = 34 +// ^hov + +let arity0a = () => { + //^hov + let f = () => 3 + f +} + +let arity0b = ((), ()) => 3 +// ^hov + +let arity0c = ((), ()) => 3 +// ^hov + +let arity0d = () => { + // ^hov + let f = () => 3 + f +} + +/**doc comment 1*/ +let docComment1 = 12 +// ^hov + +/** doc comment 2 */ +let docComment2 = 12 +// ^hov + +module ModWithDocComment = { + /*** module level doc comment 1 */ + + /** doc comment for x */ + let x = 44 + + /*** module level doc comment 2 */ +} + +module TypeSubstitutionRecords = { + type foo<'a> = {content: 'a, zzz: string} + type bar = {age: int} + type foobar = foo + + let x1: foo = {content: {age: 42}, zzz: ""} + // ^hov + let x2: foobar = {content: {age: 42}, zzz: ""} + // ^hov + + // x1.content. + // ^com + + // x2.content. + // ^com + + type foo2<'b> = foo<'b> + type foobar2 = foo2 + + let y1: foo2 = {content: {age: 42}, zzz: ""} + let y2: foobar2 = {content: {age: 42}, zzz: ""} + + // y1.content. + // ^com + + // y2.content. + // ^com +} + +module CompV4 = { + type props<'n, 's> = {n?: 'n, s: 's} + let make = props => { + let _ = props.n == Some(10) + React.string(props.s) + } +} + +let mk = CompV4.make +// ^hov + +type useR = {x: int, y: list>>} + +let testUseR = (v: useR) => v +// ^hov + +let usr: useR = { + x: 123, + y: list{}, +} + +// let f = usr +// ^hov + +module NotShadowed = { + /** Stuff */ + let xx_ = 10 + + /** More Stuff */ + let xx = xx_ +} + +module Shadowed = { + /** Stuff */ + let xx = 10 + + /** More Stuff */ + let xx = xx +} + +let _ = NotShadowed.xx +// ^hov + +let _ = Shadowed.xx +// ^hov + +type recordWithDocstringField = { + /** Mighty fine field here. */ + someField: bool, +} + +let x: recordWithDocstringField = { + someField: true, +} + +// x.someField +// ^hov + +let someField = x.someField +// ^hov + +type variant = + /** Cool variant! */ + | CoolVariant + /** Other cool variant */ + | OtherCoolVariant + +let coolVariant = CoolVariant +// ^hov + +type payloadVariants = InlineRecord({field1: int, field2: bool}) | Args(int, bool) + +let payloadVariant = InlineRecord({field1: 1, field2: true}) +// ^hov + +let payloadVariant2 = Args(1, true) +// ^hov + +module RecursiveVariants = { + type rec t = Action1(int) | Action2(float) | Batch(array) +} + +let recursiveVariant = RecursiveVariants.Action1(1) +// ^hov + +// Hover on unsaved +// let fff = "hello"; fff +// ^hov + +// switch x { | {someField} => someField } +// ^hov + +module Arr = Belt.Array +// ^hov + +type aliased = variant +// ^hov diff --git a/tests/lsp_tests/basic-workspace/Hover.res.js b/tests/lsp_tests/basic-workspace/Hover.res.js new file mode 100644 index 00000000000..84e61d64681 --- /dev/null +++ b/tests/lsp_tests/basic-workspace/Hover.res.js @@ -0,0 +1,288 @@ +// Generated by ReScript, PLEASE EDIT WITH CARE + +import * as Primitive_object from "@rescript/runtime/lib/es6/Primitive_object.mjs"; +import * as JsxRuntime from "react/jsx-runtime"; + +let Id = {}; + +function customDouble(foo) { + return (foo << 1); +} + +let Dep = { + customDouble: customDouble +}; + +function Hover$HoverInsideModuleWithComponent(props) { + return null; +} + +let HoverInsideModuleWithComponent = { + x: 2, + make: Hover$HoverInsideModuleWithComponent +}; + +function functionWithTypeAnnotation() { + return 1; +} + +function Hover(props) { + return props.name; +} + +function Hover$C2$make2(props) { + return props.name; +} + +let C2 = { + make2: Hover$C2$make2 +}; + +function log(msg) { + console.log(msg); +} + +let JsLogger = { + log: log +}; + +let IdDefinedTwice = { + y: 20, + _x: 10 +}; + +let A = { + x: 13 +}; + +function Hover$Comp(props) { + return props.children; +} + +let Comp = { + make: Hover$Comp +}; + +JsxRuntime.jsxs(Hover$Comp, { + children: [ + JsxRuntime.jsx("div", {}), + JsxRuntime.jsx("div", {}) + ] +}); + +JsxRuntime.jsxs(Hover$Comp, { + children: [ + JsxRuntime.jsx("div", {}), + JsxRuntime.jsx("div", {}) + ] +}); + +function _get(r) { + return r.f + r.i; +} + +function withAs(yyy) { + return yyy + 1 | 0; +} + +function fnnxx(b) { + return b; +} + +let AA = { + fnnxx: fnnxx +}; + +function arity0a() { + return () => 3; +} + +function arity0b(param, param$1) { + return 3; +} + +function arity0c(param, param$1) { + return 3; +} + +function arity0d() { + return () => 3; +} + +let ModWithDocComment = { + x: 44 +}; + +let TypeSubstitutionRecords_x1 = { + content: { + age: 42 + }, + zzz: "" +}; + +let TypeSubstitutionRecords_x2 = { + content: { + age: 42 + }, + zzz: "" +}; + +let TypeSubstitutionRecords_y1 = { + content: { + age: 42 + }, + zzz: "" +}; + +let TypeSubstitutionRecords_y2 = { + content: { + age: 42 + }, + zzz: "" +}; + +let TypeSubstitutionRecords = { + x1: TypeSubstitutionRecords_x1, + x2: TypeSubstitutionRecords_x2, + y1: TypeSubstitutionRecords_y1, + y2: TypeSubstitutionRecords_y2 +}; + +function make(props) { + Primitive_object.equal(props.n, 10); + return props.s; +} + +let CompV4 = { + make: make +}; + +function testUseR(v) { + return v; +} + +let NotShadowed = { + xx_: 10, + xx: 10 +}; + +let Shadowed = { + xx: 10 +}; + +let RecursiveVariants = {}; + +let abc = 56; + +let D; + +let cd = customDouble; + +let make$1 = Hover; + +let num = 34; + +let JJ; + +let B; + +let C; + +let Comp1; + +let funAlias = fnnxx; + +let typeOk = fnnxx; + +let typeDuplicate = fnnxx; + +let dd = 34; + +let docComment1 = 12; + +let docComment2 = 12; + +let mk = make; + +let usr = { + x: 123, + y: /* [] */0 +}; + +let x = { + someField: true +}; + +let someField = true; + +let coolVariant = "CoolVariant"; + +let payloadVariant = { + TAG: "InlineRecord", + field1: 1, + field2: true +}; + +let payloadVariant2 = { + TAG: "Args", + _0: 1, + _1: true +}; + +let recursiveVariant = { + TAG: "Action1", + _0: 1 +}; + +let Arr; + +export { + abc, + Id, + Dep, + D, + cd, + HoverInsideModuleWithComponent, + functionWithTypeAnnotation, + make$1 as make, + C2, + num, + JsLogger, + JJ, + IdDefinedTwice, + A, + B, + C, + Comp, + Comp1, + _get, + withAs, + AA, + funAlias, + typeOk, + typeDuplicate, + dd, + arity0a, + arity0b, + arity0c, + arity0d, + docComment1, + docComment2, + ModWithDocComment, + TypeSubstitutionRecords, + CompV4, + mk, + testUseR, + usr, + NotShadowed, + Shadowed, + x, + someField, + coolVariant, + payloadVariant, + payloadVariant2, + RecursiveVariants, + recursiveVariant, + Arr, +} +/* Not a pure module */ diff --git a/tests/lsp_tests/basic-workspace/package.json b/tests/lsp_tests/basic-workspace/package.json new file mode 100644 index 00000000000..950bea0a1f9 --- /dev/null +++ b/tests/lsp_tests/basic-workspace/package.json @@ -0,0 +1,14 @@ +{ + "name": "@tests/lsp-tests-basic-workspace", + "type": "module", + "private": true, + "scripts": { + "build": "rescript build", + "clean": "rescript clean", + "dev": "rescript -w" + }, + "dependencies": { + "@rescript/react": "workspace:^", + "rescript": "workspace:^" + } +} diff --git a/tests/lsp_tests/basic-workspace/rescript.json b/tests/lsp_tests/basic-workspace/rescript.json new file mode 100644 index 00000000000..76742555703 --- /dev/null +++ b/tests/lsp_tests/basic-workspace/rescript.json @@ -0,0 +1,13 @@ +{ + "name": "@tests/lsp-tests-basic-workspace", + "sources": { + "dir": "." + }, + "package-specs": { + "module": "esmodule", + "in-source": true + }, + "suffix": ".res.js", + "dependencies": ["@rescript/react"], + "jsx": { "version": 4 } +} diff --git a/tests/lsp_tests/dune b/tests/lsp_tests/dune new file mode 100644 index 00000000000..ecbed12aff6 --- /dev/null +++ b/tests/lsp_tests/dune @@ -0,0 +1,9 @@ +(executable + (name test) + (package rescript-language-server) + (public_name lsp-tests) + (libraries lsp jsonrpc yojson eio eio_main eio.unix) + (flags + (-w "-9-32-33"))) + + (dirs (:standard \ ignored_dir basic-workspace)) diff --git a/tests/lsp_tests/expected/Hover.res.expected b/tests/lsp_tests/expected/Hover.res.expected new file mode 100644 index 00000000000..c71369a28a4 --- /dev/null +++ b/tests/lsp_tests/expected/Hover.res.expected @@ -0,0 +1,331 @@ +Request textDocument/hover Line: 1 Character: 4 +Response +{ "contents": { "kind": "markdown", "value": "```rescript\nint\n```" } } + +Request textDocument/hover Line: 4 Character: 5 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\ntype t = (int, float)\n```" + } +} + +Request textDocument/hover Line: 7 Character: 7 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nmodule Id: {\n type x = int\n}\n```" + } +} + +Request textDocument/hover Line: 20 Character: 11 +Response +{ + "contents": { + "kind": "markdown", + "value": "\nThis module is commented\n---\n\n```\n \n```\n```rescript\nmodule Dep: {\n let customDouble: int => int\n}\n```" + } +} + +Request textDocument/hover Line: 23 Character: 11 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nint => int\n```\n---\nSome doc comment" + } +} + +Request textDocument/hover Line: 27 Character: 6 +Response +{ "contents": { "kind": "markdown", "value": "```rescript\nint\n```" } } + +Request textDocument/hover Line: 34 Character: 4 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nunit => int\n```\n---\nDoc comment for functionWithTypeAnnotation" + } +} + +Request textDocument/hover Line: 38 Character: 13 +Response +{ "contents": { "kind": "markdown", "value": "```rescript\nstring\n```" } } + +Request textDocument/hover Line: 43 Character: 15 +Response +{ "contents": { "kind": "markdown", "value": "```rescript\nstring\n```" } } + +Request textDocument/hover Line: 47 Character: 10 +Response +{ "contents": { "kind": "markdown", "value": "```rescript\nint\n```" } } + +Request textDocument/hover Line: 50 Character: 13 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nmodule type Logger = {\n let log: string => unit\n}\n```" + } +} + +Request textDocument/hover Line: 55 Character: 7 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nmodule type Logger = {\n let log: string => unit\n}\n```" + } +} + +Command `def` not implemented!Request textDocument/hover Line: 64 Character: 9 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nmodule IdDefinedTwice: {\n let y: int\n let _x: int\n}\n```" + } +} + +Request textDocument/hover Line: 75 Character: 7 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nmodule A: {\n let x: int\n}\n```" + } +} + +Request textDocument/hover Line: 78 Character: 7 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nmodule A: {\n let x: int\n}\n```" + } +} + +Request textDocument/hover Line: 92 Character: 10 +Response +null + +Request textDocument/hover Line: 99 Character: 10 +Response +null + +Request textDocument/hover Line: 104 Character: 25 +Response +{ "contents": { "kind": "markdown", "value": "```rescript\nfloat\n```" } } + +Request textDocument/hover Line: 107 Character: 21 +Response +{ "contents": { "kind": "markdown", "value": "```rescript\nint\n```" } } + +Request textDocument/hover Line: 117 Character: 16 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nAA.cond<([< #str(string)] as 'a)> => AA.cond<'a>\n```\n\n---\n\n```\n \n```\n```rescript\ntype AA.cond<'a> = 'a\n constraint 'a = [< #str(string)]\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2F%2Fhome%2Fpedro%2FDesktop%2Fprojects%2Frescript-compiler%2Ftests%2Flsp_tests%2Fbasic-workspace%2FHover.res%22%2C110%2C2%5D)\n" + } +} + +Request textDocument/hover Line: 120 Character: 25 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nAA.cond<([< #str(string)] as 'a)> => AA.cond<'a>\n```\n\n---\n\n```\n \n```\n```rescript\ntype AA.cond<'a> = 'a\n constraint 'a = [< #str(string)]\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2F%2Fhome%2Fpedro%2FDesktop%2Fprojects%2Frescript-compiler%2Ftests%2Flsp_tests%2Fbasic-workspace%2FHover.res%22%2C110%2C2%5D)\n" + } +} + +Request textDocument/hover Line: 123 Character: 3 +Response +{ + "contents": { + "kind": "markdown", + "value": "The `@live` decorator is for reanalyze, a static analysis tool for ReScript that can do dead code analysis.\n\n`@live` tells the dead code analysis that the value should be considered live, even though it might appear to be dead. This is typically used in case of FFI where there are indirect ways to access values. It can be added to everything that could otherwise be considered unused by the dead code analysis - values, functions, arguments, records, individual record fields, and so on.\n\n[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#live-decorator).\n\nHint: Did you know you can run an interactive code analysis in your project by running the command `> ReScript: Start Code Analyzer`? Try it!" + } +} + +Request textDocument/hover Line: 132 Character: 4 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\n(unit, unit) => int\n```" + } +} + +Request textDocument/hover Line: 135 Character: 4 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\n(unit, unit) => int\n```" + } +} + +Request textDocument/hover Line: 138 Character: 5 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nunit => unit => int\n```" + } +} + +Request textDocument/hover Line: 145 Character: 9 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nint\n```\n---\ndoc comment 1" + } +} + +Request textDocument/hover Line: 149 Character: 6 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nint\n```\n---\n doc comment 2 " + } +} + +Request textDocument/hover Line: 166 Character: 23 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nfoo\n```\n\n---\n\n```\n \n```\n```rescript\ntype foo<'a> = {content: 'a, zzz: string}\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2F%2Fhome%2Fpedro%2FDesktop%2Fprojects%2Frescript-compiler%2Ftests%2Flsp_tests%2Fbasic-workspace%2FHover.res%22%2C161%2C2%5D)\n\n\n---\n\n```\n \n```\n```rescript\ntype bar = {age: int}\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2F%2Fhome%2Fpedro%2FDesktop%2Fprojects%2Frescript-compiler%2Ftests%2Flsp_tests%2Fbasic-workspace%2FHover.res%22%2C162%2C2%5D)\n" + } +} + +Request textDocument/hover Line: 168 Character: 22 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nfoobar\n```\n\n---\n\n```\n \n```\n```rescript\ntype foobar = foo\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2F%2Fhome%2Fpedro%2FDesktop%2Fprojects%2Frescript-compiler%2Ftests%2Flsp_tests%2Fbasic-workspace%2FHover.res%22%2C163%2C2%5D)\n" + } +} + +Command `com` not implemented!Command `com` not implemented!Command `com` not implemented!Command `com` not implemented!Request textDocument/hover Line: 198 Character: 4 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nCompV4.props => React.element\n```\n\n---\n\n```\n \n```\n```rescript\ntype CompV4.props<'n, 's> = {n?: 'n, s: 's}\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2F%2Fhome%2Fpedro%2FDesktop%2Fprojects%2Frescript-compiler%2Ftests%2Flsp_tests%2Fbasic-workspace%2FHover.res%22%2C190%2C2%5D)\n\n\n---\n\n```\n \n```\n```rescript\ntype React.element = Jsx.element\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2F%2Fhome%2Fpedro%2FDesktop%2Fprojects%2Frescript-compiler%2Ftests%2Fdependencies%2Frescript-react%2Fsrc%2FReact.res%22%2C0%2C0%5D)\n" + } +} + +Request textDocument/hover Line: 203 Character: 16 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nuseR\n```\n\n---\n\n```\n \n```\n```rescript\ntype useR = {x: int, y: list>>}\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2F%2Fhome%2Fpedro%2FDesktop%2Fprojects%2Frescript-compiler%2Ftests%2Flsp_tests%2Fbasic-workspace%2FHover.res%22%2C200%2C0%5D)\n\n\n---\n\n```\n \n```\n```rescript\ntype r<'a> = {i: 'a, f: float}\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2F%2Fhome%2Fpedro%2FDesktop%2Fprojects%2Frescript-compiler%2Ftests%2Flsp_tests%2Fbasic-workspace%2FHover.res%22%2C101%2C0%5D)\n" + } +} + +Request textDocument/hover Line: 211 Character: 13 +Response +null + +Request textDocument/hover Line: 230 Character: 20 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nint\n```\n---\n More Stuff " + } +} + +Request textDocument/hover Line: 233 Character: 17 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nint\n```\n---\n More Stuff " + } +} + +Request textDocument/hover Line: 245 Character: 6 +Response +null + +Request textDocument/hover Line: 248 Character: 19 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nbool\n```\n---\n Mighty fine field here. " + } +} + +Request textDocument/hover Line: 257 Character: 20 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nvariant\nCoolVariant\n```\n---\n Cool variant! \n\n---\n\n```\n \n```\n```rescript\ntype variant = CoolVariant | OtherCoolVariant\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2F%2Fhome%2Fpedro%2FDesktop%2Fprojects%2Frescript-compiler%2Ftests%2Flsp_tests%2Fbasic-workspace%2FHover.res%22%2C250%2C0%5D)\n" + } +} + +Request textDocument/hover Line: 262 Character: 22 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\npayloadVariants\nInlineRecord({field1: int, field2: bool})\n```\n\n---\n\n```\n \n```\n```rescript\ntype payloadVariants =\n | InlineRecord({field1: int, field2: bool})\n | Args(int, bool)\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2F%2Fhome%2Fpedro%2FDesktop%2Fprojects%2Frescript-compiler%2Ftests%2Flsp_tests%2Fbasic-workspace%2FHover.res%22%2C259%2C0%5D)\n" + } +} + +Request textDocument/hover Line: 265 Character: 23 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\npayloadVariants\nArgs(int, bool)\n```\n\n---\n\n```\n \n```\n```rescript\ntype payloadVariants =\n | InlineRecord({field1: int, field2: bool})\n | Args(int, bool)\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2F%2Fhome%2Fpedro%2FDesktop%2Fprojects%2Frescript-compiler%2Ftests%2Flsp_tests%2Fbasic-workspace%2FHover.res%22%2C259%2C0%5D)\n" + } +} + +Request textDocument/hover Line: 272 Character: 42 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nRecursiveVariants.t\nAction1(int)\n```\n\n---\n\n```\n \n```\n```rescript\ntype RecursiveVariants.t =\n | Action1(int)\n | Action2(float)\n | Batch(array)\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2F%2Fhome%2Fpedro%2FDesktop%2Fprojects%2Frescript-compiler%2Ftests%2Flsp_tests%2Fbasic-workspace%2FHover.res%22%2C268%2C2%5D)\n" + } +} + +Request textDocument/hover Line: 276 Character: 23 +Response +null + +Request textDocument/hover Line: 279 Character: 33 +Response +null + +Request textDocument/hover Line: 282 Character: 8 +Response +{ + "contents": { + "kind": "markdown", + "value": "\n [`Belt.Array`]()\n\n **mutable array**: Utilities functions\n\n---\n\n```\n \n```\n```rescript\nmodule Array: {\n module Id\n module Array\n module SortArray\n module MutableQueue\n module MutableStack\n module List\n module Range\n module Set\n module Map\n module MutableSet\n module MutableMap\n module HashSet\n module HashMap\n module Option\n module Result\n module Int\n module Float\n}\n```" + } +} + +Request textDocument/hover Line: 285 Character: 6 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\ntype aliased = variant\n```\n\n---\n\n```\n \n```\n```rescript\ntype variant = CoolVariant | OtherCoolVariant\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2F%2Fhome%2Fpedro%2FDesktop%2Fprojects%2Frescript-compiler%2Ftests%2Flsp_tests%2Fbasic-workspace%2FHover.res%22%2C250%2C0%5D)\n" + } +} + diff --git a/tests/lsp_tests/test.ml b/tests/lsp_tests/test.ml new file mode 100644 index 00000000000..378671874ee --- /dev/null +++ b/tests/lsp_tests/test.ml @@ -0,0 +1,258 @@ +module Helper = struct + (** Helpers for spawning the ReScript language server in tests, sending + LSP requests/notifications over stdio, and reading responses back. *) + + let server_binary = "_build/default/lsp/bin/main.exe" + + type t = { + proc: [`Generic | `Unix] Eio.Process.ty Eio.Resource.t; + stdin: Eio_unix.sink_ty Eio.Resource.t; + stdout: Eio.Buf_read.t; + mutable next_id: int; + } + + let frame (json : Yojson.Safe.t) : string = + let body = Yojson.Safe.to_string json in + Printf.sprintf "Content-Length: %d\r\n\r\n%s" (String.length body) body + + let read_headers buf = + let rec loop acc = + match Eio.Buf_read.line buf with + | "" -> Some acc + | line -> + let acc = + match String.index_opt line ':' with + | None -> acc + | Some i -> + let k = String.sub line 0 i in + let v = + String.trim (String.sub line (i + 1) (String.length line - i - 1)) + in + (k, v) :: acc + in + loop acc + | exception End_of_file -> if acc = [] then None else Some acc + in + loop [] + + let read_message buf = + match read_headers buf with + | None -> None + | Some headers -> + let len = int_of_string (List.assoc "Content-Length" headers) in + let body = Eio.Buf_read.take len buf in + Some (Yojson.Safe.from_string body) + + let start ~sw ~env = + let mgr = Eio.Stdenv.process_mgr env in + let stdin_r, stdin_w = Eio_unix.pipe sw in + let stdout_r, stdout_w = Eio_unix.pipe sw in + let proc = + Eio.Process.spawn ~sw mgr ~stdin:stdin_r ~stdout:stdout_w + ~executable:server_binary [] + in + Eio.Resource.close stdin_r; + Eio.Resource.close stdout_w; + let stdout = Eio.Buf_read.of_flow ~max_size:(16 * 1024 * 1024) stdout_r in + {proc; stdin = stdin_w; stdout; next_id = 0} + + let send_packet t (packet : Jsonrpc.Packet.t) = + let json = Jsonrpc.Packet.yojson_of_t packet in + Eio.Flow.copy_string (frame json) t.stdin + + let next_id t = + t.next_id <- t.next_id + 1; + t.next_id + + (** Send a typed LSP request and return the assigned id. *) + let send_request t (req : 'r Lsp.Client_request.t) = + let id = `Int (next_id t) in + let jsonrpc_req = Lsp.Client_request.to_jsonrpc_request req ~id in + send_packet t (Jsonrpc.Packet.Request jsonrpc_req); + id + + (** Send a typed LSP notification. *) + let send_notification t (notif : Lsp.Client_notification.t) = + let jsonrpc_notif = Lsp.Client_notification.to_jsonrpc notif in + send_packet t (Jsonrpc.Packet.Notification jsonrpc_notif) + + (** Read packets until we find the response matching [id]. Server + notifications/requests received in the meantime are discarded. *) + let rec read_response t id = + match read_message t.stdout with + | None -> failwith "Helper.read_response: unexpected EOF" + | Some json -> ( + match Jsonrpc.Packet.t_of_yojson json with + | Response resp when resp.id = id -> resp + | _ -> read_response t id) + + (** Send a typed request and synchronously wait for its response, decoded + back into the request's result type. *) + let request (type r) t (req : r Lsp.Client_request.t) : r = + let id = send_request t req in + let resp = read_response t id in + match resp.result with + | Ok json -> Lsp.Client_request.response_of_json req json + | Error err -> failwith ("LSP error response: " ^ err.message) + + (** Read the next packet of any kind. Useful when waiting for a server + notification (e.g. publishDiagnostics). *) + (* let read_packet t = + match read_message t.stdout with + | None -> failwith "Helper.read_packet: unexpected EOF" + | Some json -> Jsonrpc.Packet.t_of_yojson json *) + + let stop t = + (try Eio.Resource.close t.stdin with _ -> ()); + Eio.Process.await t.proc + + (** Run [f] with a freshly started server, ensuring the process is stopped + and the switch is released afterwards. *) + let with_server ~env f = + Eio.Switch.run @@ fun sw -> + let t = start ~sw ~env in + Fun.protect ~finally:(fun () -> ignore (stop t)) (fun () -> f t) +end + +open Lsp +open Types + +type caret_comment = { + path: string; + line: int; (* line of the comment *) + col: int; (* column of the ^ character *) + command: string; (* e.g. "hov" *) + text: string; +} + +module StringMap = Map.Make (String) + +let find_caret_comments ~fs ~dir = + let results = ref [] in + + (* Read all .res files in directory *) + Eio.Path.with_open_dir + Eio.Path.(fs / dir) + (fun dir_handle -> + Eio.Path.read_dir dir_handle + |> List.filter (String.ends_with ~suffix:".res") + |> List.iter (fun filename -> + let path = Eio.Path.(dir_handle / filename) in + let content = Eio.Path.load path in + let lines = String.split_on_char '\n' content in + + List.iteri + (fun line_idx line -> + (* Match lines like "// ^command" *) + match String.trim line with + | s when String.length s > 3 && String.sub s 0 3 = "// " -> ( + let rest = String.sub s 3 (String.length s - 3) in + match String.index_opt rest '^' with + | None -> () + | Some caret_in_rest -> + (* Column of ^ in original line *) + let prefix_len = + String.length line - String.length (String.trim line) + in + let col = prefix_len + 3 + caret_in_rest in + let command = + let after = caret_in_rest + 1 in + if after < String.length rest then + String.trim + (String.sub rest after (String.length rest - after)) + else "" + in + results := + { + (* TODO: rewrite this *) + path = Sys.getcwd () ^ "/" ^ dir ^ "/" ^ snd path; + line = line_idx; + col; + command; + text = content; + } + :: !results) + | _ -> ()) + lines)); + + List.rev !results + +let run_test ~fs ~dir server = + let comments = find_caret_comments ~fs ~dir in + + let send_request payload method_ (caret_comment : caret_comment) = + let request_str = + Printf.sprintf "%s Line: %d Character: %d" method_ caret_comment.line + caret_comment.col + in + let response = Helper.request server payload in + let response_str = + Client_request.yojson_of_result payload response + |> Yojson.Safe.pretty_to_string ~std:false + in + Printf.sprintf "Request %s\nResponse\n%s\n\n" request_str response_str + in + + let open_document ~uri ~text = + Helper.send_notification server + (Client_notification.TextDocumentDidOpen + (DidOpenTextDocumentParams.create + ~textDocument: + (TextDocumentItem.create ~uri ~languageId:"rescript" ~version:0 + ~text))) + in + + let comment_to_lsp (caret_comment : caret_comment) = + let uri = DocumentUri.of_path caret_comment.path in + let textDocument = TextDocumentIdentifier.create ~uri in + + let character = caret_comment.col in + let line = caret_comment.line - 1 in + let position = Position.create ~line ~character in + let text = caret_comment.text in + + match caret_comment.command with + | "hov" -> + open_document ~uri ~text; + send_request + (Client_request.TextDocumentHover + (HoverParams.create ~textDocument ~position ())) + "textDocument/hover" caret_comment + (* | "cmp" -> + let context = + CompletionContext.create ~triggerCharacter:">" + ~triggerKind:CompletionTriggerKind.TriggerCharacter () + in + send_request + (Client_request.TextDocumentCompletion + (CompletionParams.create ~textDocument ~position ~context ())) + "textDocument/completion" caret_comment *) + | other -> Printf.sprintf "Command `%s` not implemented!" other + in + + let grouped = + List.fold_left + (fun acc comment -> + let others = + Option.value ~default:[] (StringMap.find_opt comment.path acc) + in + StringMap.add comment.path (comment :: others) acc) + StringMap.empty comments + in + + StringMap.iter + (fun path comments -> + let filename = Filename.basename path ^ ".expected" in + let save_path = Filename.concat "tests/lsp_tests/expected" filename in + let content = List.rev_map comment_to_lsp comments |> String.concat "" in + let file = Eio.Path.(fs / save_path) in + Eio.Path.save ~create:(`Or_truncate 0o644) file content) + grouped + +let main () = + Eio_main.run @@ fun env -> + Helper.with_server ~env @@ fun server -> + run_test ~fs:env#fs ~dir:"tests/lsp_tests/basic-workspace" server; + Helper.stop server |> ignore + +let () = main () diff --git a/yarn.lock b/yarn.lock index af3369dbea2..29db1fe74d4 100644 --- a/yarn.lock +++ b/yarn.lock @@ -734,6 +734,15 @@ __metadata: languageName: unknown linkType: soft +"@tests/lsp-tests-basic-workspace@workspace:tests/lsp_tests/basic-workspace": + version: 0.0.0-use.local + resolution: "@tests/lsp-tests-basic-workspace@workspace:tests/lsp_tests/basic-workspace" + dependencies: + "@rescript/react": "workspace:^" + rescript: "workspace:^" + languageName: unknown + linkType: soft + "@tests/reanalyze-benchmark@workspace:tests/analysis_tests/tests-reanalyze/deadcode-benchmark": version: 0.0.0-use.local resolution: "@tests/reanalyze-benchmark@workspace:tests/analysis_tests/tests-reanalyze/deadcode-benchmark"