From 693422ce4ed66b5afd3d59afbe427e9ff4bb26e2 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sun, 1 Dec 2024 12:31:31 -0300 Subject: [PATCH 01/37] 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 02/37] 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 03/37] 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 04/37] 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 05/37] 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 06/37] 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" From 169262900bc50dfbe824e65a0858803ac18e4b5c Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Fri, 15 May 2026 23:53:13 -0300 Subject: [PATCH 07/37] Refactor analysis to decouple I/O from core logic Splits `Commands.ml` into a pure layer that returns OCaml values (option, list, typed records like Protocol.hover, Protocol.signatureHelp, Protocol.completionItem) and a new `analysis/src/Cli.ml` that does the stringify-and-print step. `analysis/bin/main.ml` now dispatches to `Cli.*`, while the LSP server consumes `Commands.*` directly. Makes the parsers accept source strings: `res_driver` gains `parse_interface_from_source` alongside the existing `parse_implementation_from_source` --- analysis/bin/main.ml | 45 +- analysis/src/Cli.ml | 385 +++++++++++++++++ analysis/src/Codemod.ml | 4 +- analysis/src/Commands.ml | 429 ++++--------------- analysis/src/CompletionFrontEnd.ml | 37 +- analysis/src/Completions.ml | 16 +- analysis/src/Diagnostics.ml | 16 +- analysis/src/Hint.ml | 50 +-- analysis/src/Hover.ml | 14 +- analysis/src/Protocol.ml | 15 + analysis/src/SemanticTokens.ml | 71 ++- analysis/src/SignatureHelp.ml | 34 +- analysis/src/Xform.ml | 44 +- compiler/syntax/src/res_ast_debugger.ml | 19 +- compiler/syntax/src/res_driver.ml | 36 +- compiler/syntax/src/res_driver.mli | 12 +- compiler/syntax/src/res_driver_binary.ml | 7 +- compiler/syntax/src/res_driver_ml_printer.ml | 5 +- compiler/syntax/src/res_token_debugger.ml | 8 +- 19 files changed, 721 insertions(+), 526 deletions(-) create mode 100644 analysis/src/Cli.ml diff --git a/analysis/bin/main.ml b/analysis/bin/main.ml index e5075f102ed..0afe23855ab 100644 --- a/analysis/bin/main.ml +++ b/analysis/bin/main.ml @@ -134,22 +134,18 @@ let main () = | _ -> print_endline "\"ERR: Did not find root \"") | [_; "completion"; path; line; col; currentFile] -> printHeaderInfo path line col; - Commands.completion ~debug ~path + Cli.completion ~debug ~path ~pos:(int_of_string line, int_of_string col) ~currentFile | [_; "completionResolve"; path; modulePath] -> - Commands.completionResolve ~path ~modulePath + Cli.completionResolve ~path ~modulePath | [_; "definition"; path; line; col] -> - Commands.definition ~path - ~pos:(int_of_string line, int_of_string col) - ~debug + Cli.definition ~path ~pos:(int_of_string line, int_of_string col) ~debug | [_; "typeDefinition"; path; line; col] -> - Commands.typeDefinition ~path - ~pos:(int_of_string line, int_of_string col) - ~debug + Cli.typeDefinition ~path ~pos:(int_of_string line, int_of_string col) ~debug | [_; "documentSymbol"; path] -> DocumentSymbol.command ~path | [_; "hover"; path; line; col; currentFile; supportsMarkdownLinks] -> - Commands.hover ~path + Cli.hover ~path ~pos:(int_of_string line, int_of_string col) ~currentFile ~debug ~supportsMarkdownLinks: @@ -159,7 +155,7 @@ let main () = | [ _; "signatureHelp"; path; line; col; currentFile; allowForConstructorPayloads; ] -> - Commands.signatureHelp ~path + Cli.signatureHelp ~path ~pos:(int_of_string line, int_of_string col) ~currentFile ~debug ~allowForConstructorPayloads: @@ -167,13 +163,13 @@ let main () = | "true" -> true | _ -> false) | [_; "inlayHint"; path; line_start; line_end; maxLength] -> - Commands.inlayhint ~path + Cli.inlayhint ~path ~pos:(int_of_string line_start, int_of_string line_end) ~maxLength ~debug - | [_; "codeLens"; path] -> Commands.codeLens ~path ~debug + | [_; "codeLens"; path] -> Cli.codeLens ~path ~debug | [_; "codeAction"; path; startLine; startCol; endLine; endCol; currentFile] -> - Commands.codeAction ~path + Cli.codeAction ~path ~startPos:(int_of_string startLine, int_of_string startCol) ~endPos:(int_of_string endLine, int_of_string endCol) ~currentFile ~debug @@ -183,34 +179,29 @@ let main () = | "add-missing-cases" -> Codemod.AddMissingCases | _ -> raise (Failure "unsupported type") in + let source = Files.readFile path |> Option.value ~default:"" in let res = - Codemod.transform ~path + Codemod.transform ~source ~pos:(int_of_string line, int_of_string col) ~debug ~typ ~hint |> Json.escape in Printf.printf "\"%s\"" res - | [_; "diagnosticSyntax"; path] -> Commands.diagnosticSyntax ~path + | [_; "diagnosticSyntax"; path] -> Cli.diagnosticSyntax ~path | [_; "references"; path; line; col] -> - Commands.references ~path - ~pos:(int_of_string line, int_of_string col) - ~debug + Cli.references ~path ~pos:(int_of_string line, int_of_string col) ~debug | [_; "prepareRename"; path; line; col] -> - Commands.prepareRename ~path - ~pos:(int_of_string line, int_of_string col) - ~debug + Cli.prepareRename ~path ~pos:(int_of_string line, int_of_string col) ~debug | [_; "rename"; path; line; col; newName] -> - Commands.rename ~path + Cli.rename ~path ~pos:(int_of_string line, int_of_string col) ~newName ~debug - | [_; "semanticTokens"; currentFile] -> - SemanticTokens.semanticTokens ~currentFile + | [_; "semanticTokens"; currentFile] -> Cli.semanticTokens ~path:currentFile | [_; "createInterface"; path; cmiFile] -> Printf.printf "\"%s\"" (Json.escape (CreateInterface.command ~path ~cmiFile)) - | [_; "format"; path] -> - Printf.printf "\"%s\"" (Json.escape (Commands.format ~path)) - | [_; "test"; path] -> Commands.test ~path + | [_; "format"; path] -> Cli.format ~path + | [_; "test"; path] -> Cli.test ~path | [_; "cmt"; rescript_json; cmt_path] -> CmtViewer.dump rescript_json cmt_path | args when List.mem "-h" args || List.mem "--help" args -> prerr_endline help | _ -> diff --git a/analysis/src/Cli.ml b/analysis/src/Cli.ml new file mode 100644 index 00000000000..bd8ced94a14 --- /dev/null +++ b/analysis/src/Cli.ml @@ -0,0 +1,385 @@ +let completion ~debug ~path ~pos ~currentFile = + let full = Cmt.loadFullCmtFromPath ~path in + let kindFile = Files.classifySourceFile currentFile in + match Files.readFile currentFile with + | None | Some "" -> Protocol.null |> print_endline + | Some source -> + Commands.completion ~debug ~source ~kindFile ~pos ~full + |> List.map Protocol.stringifyCompletionItem + |> Protocol.array |> print_endline + +let completionResolve ~path ~modulePath = + let full = Cmt.loadFullCmtFromPath ~path in + let result = + match Commands.completionResolve ~full ~modulePath with + | None -> Protocol.null + | Some content -> Protocol.wrapInQuotes content + in + print_endline result + +let inlayhint ~path ~pos ~maxLength ~debug = + let full = Cmt.loadFullCmtFromPath ~path in + let kindFile = Files.classifySourceFile path in + match Files.readFile path with + | None -> Protocol.null |> print_endline + | Some source -> ( + match Hint.inlay ~source ~kindFile ~pos ~maxLength ~full ~debug with + | Some hints -> + hints + |> List.map Protocol.stringifyHint + |> Protocol.array |> print_endline + | None -> Protocol.null |> print_endline) + +let codeLens ~path ~debug = + let full = Cmt.loadFullCmtFromPath ~path in + let kindFile = Files.classifySourceFile path in + match Files.readFile path with + | None -> Protocol.null |> print_endline + | Some source -> ( + match Hint.codeLens ~source ~kindFile ~full ~debug with + | Some lens -> + lens + |> List.map Protocol.stringifyCodeLens + |> Protocol.array |> print_endline + | None -> Protocol.null |> print_endline) + +let hover ~path ~pos ~currentFile ~debug ~supportsMarkdownLinks = + let full = Cmt.loadFullCmtFromPath ~path in + let kindFile = Files.classifySourceFile currentFile in + match Files.readFile currentFile with + | None -> Protocol.null |> print_endline + | Some source -> + let result = + match + Commands.hover ~source ~kindFile ~pos ~debug ~supportsMarkdownLinks + ~full + with + | Some value -> Protocol.stringifyHover value + | None -> Protocol.null + in + print_endline result + +let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads = + let full = Cmt.loadFullCmtFromPath ~path in + let kindFile = Files.classifySourceFile currentFile in + match Files.readFile currentFile with + | None -> Protocol.null |> print_endline + | Some source -> + Commands.signatureHelp ~source ~kindFile ~pos ~allowForConstructorPayloads + ~full ~debug + |> Protocol.stringifySignatureHelp |> print_endline + +let codeAction ~path ~startPos ~endPos ~currentFile ~debug = + let kindFile = Files.classifySourceFile currentFile in + match Files.readFile currentFile with + | None -> Protocol.null |> print_endline + | Some source -> + Xform.extractCodeActions ~path ~startPos ~endPos ~source ~kindFile ~debug + |> CodeActions.stringifyCodeActions |> print_endline + +let definition ~path ~pos ~debug = + let full = Cmt.loadFullCmtFromPath ~path in + print_endline + (match Commands.definition ~full ~pos ~debug with + | None -> Protocol.null + | Some location -> location |> Protocol.stringifyLocation) + +let typeDefinition ~path ~pos ~debug = + let full = Cmt.loadFullCmtFromPath ~path in + print_endline + (match Commands.typeDefinition ~full ~pos ~debug with + | None -> Protocol.null + | Some location -> location |> Protocol.stringifyLocation) + +let references ~path ~pos ~debug = + let full = Cmt.loadFullCmtFromPath ~path in + let allLocs = Commands.references ~full ~pos ~debug in + print_endline + (if allLocs = [] then Protocol.null + else + "[\n" + ^ (allLocs |> List.map Protocol.stringifyLocation |> String.concat ",\n") + ^ "\n]") + +let rename ~path ~pos ~newName ~debug = + let full = Cmt.loadFullCmtFromPath ~path in + let result = + match Commands.rename ~full ~pos ~newName ~debug with + | None -> Protocol.null + | Some (fileRenames, textDocumentEdits) -> + let fileRenamesString = + fileRenames |> List.map Protocol.stringifyRenameFile + in + let textDocumentEditsString = + textDocumentEdits |> List.map Protocol.stringifyTextDocumentEdit + in + "[\n" + ^ (fileRenamesString @ textDocumentEditsString |> String.concat ",\n") + ^ "\n]" + in + print_endline result + +let prepareRename ~path ~pos ~debug = + let full = Cmt.loadFullCmtFromPath ~path in + let result = + match Commands.prepareRename ~full ~pos ~debug with + | None -> Protocol.null + | Some (Range range) -> Protocol.stringifyRange range + | Some (Placeholder rangeph) -> + Protocol.stringifyRangeWithPlaceholder rangeph + in + print_endline result + +let format ~path = + match Files.readFile path with + | None -> Protocol.null |> print_endline + | Some source -> ( + let kindFile = Files.classifySourceFile path in + match Commands.format ~source ~kindFile with + | Ok textEdits -> ( + match textEdits with + | {newText} :: _ -> Printf.printf "\"%s\"" (Json.escape newText) + | _ -> Protocol.null |> print_endline) + | Error _ -> Protocol.null |> print_endline) + +let diagnosticSyntax ~path = + match Files.readFile path with + | None -> Protocol.array [""] |> print_endline + | Some source -> + let kindFile = Files.classifySourceFile path in + Diagnostics.document_syntax ~source ~kindFile + |> List.map Protocol.stringifyDiagnostic + |> Protocol.array |> print_endline + +let semanticTokens ~path = + match Files.readFile path with + | None -> Protocol.null |> print_endline + | Some source -> + let kindFile = Files.classifySourceFile path in + let tokens = SemanticTokens.semanticTokens ~source ~kindFile in + let data = SemanticTokens.Token.arrayToJsonString tokens.data in + Printf.printf "{\"data\":%s}" data + +let test ~path = + Uri.stripPath := true; + match Files.readFile path with + | None -> assert false + | Some text -> + let lines = text |> String.split_on_char '\n' in + let processLine i line = + let createCurrentFile () = + let currentFile, cout = + Filename.open_temp_file "def" ("txt." ^ Filename.extension path) + in + let removeLineComment l = + let len = String.length l in + let rec loop i = + if i + 2 <= len && l.[i] = '/' && l.[i + 1] = '/' then Some (i + 2) + else if i + 2 < len && l.[i] = ' ' then loop (i + 1) + else None + in + match loop 0 with + | None -> l + | Some indexAfterComment -> + String.make indexAfterComment ' ' + ^ String.sub l indexAfterComment (len - indexAfterComment) + in + lines + |> List.iteri (fun j l -> + let lineToOutput = + if j == i - 1 then removeLineComment l else l + in + Printf.fprintf cout "%s\n" lineToOutput); + close_out cout; + currentFile + in + if Str.string_match (Str.regexp "^ *//[ ]*\\^") line 0 then + let matched = Str.matched_string line in + let len = line |> String.length in + let mlen = String.length matched in + let rest = String.sub line mlen (len - mlen) in + let line = i - 1 in + let col = mlen - 1 in + if mlen >= 3 then ( + (match String.sub rest 0 3 with + | "db+" -> Log.verbose := true + | "db-" -> Log.verbose := false + | "dv+" -> Debug.debugLevel := Verbose + | "dv-" -> Debug.debugLevel := Off + | "in+" -> Cfg.inIncrementalTypecheckingMode := true + | "in-" -> Cfg.inIncrementalTypecheckingMode := false + | "ve+" -> ( + let version = String.sub rest 3 (String.length rest - 3) in + let version = String.trim version in + if Debug.verbose () then + Printf.printf "Setting version: %s\n" version; + match String.split_on_char '.' version with + | [majorRaw; minorRaw] -> + let version = (int_of_string majorRaw, int_of_string minorRaw) in + Packages.overrideRescriptVersion := Some version + | _ -> ()) + | "ve-" -> Packages.overrideRescriptVersion := None + | "def" -> + print_endline + ("Definition " ^ path ^ " " ^ string_of_int line ^ ":" + ^ string_of_int col); + definition ~path ~pos:(line, col) ~debug:true + | "com" -> + print_endline + ("Complete " ^ path ^ " " ^ string_of_int line ^ ":" + ^ string_of_int col); + let currentFile = createCurrentFile () in + completion ~debug:true ~path ~pos:(line, col) ~currentFile; + Sys.remove currentFile + | "cre" -> + let modulePath = String.sub rest 3 (String.length rest - 3) in + let modulePath = String.trim modulePath in + print_endline ("Completion resolve: " ^ modulePath); + completionResolve ~path ~modulePath + | "dce" -> + print_endline ("DCE " ^ path); + Reanalyze.RunConfig.runConfig.suppress <- ["src"]; + Reanalyze.RunConfig.runConfig.unsuppress <- + [Filename.concat "src" "dce"]; + DceCommand.command () + | "doc" -> + print_endline ("DocumentSymbol " ^ path); + DocumentSymbol.command ~path + | "hig" -> + print_endline ("Highlight " ^ path); + let source = Files.readFile path |> Option.get in + let kindFile = Files.classifySourceFile path in + + SemanticTokens.command ~debug:true + ~emitter:(SemanticTokens.Token.createEmitter ()) + ~source ~kindFile + | "hov" -> + print_endline + ("Hover " ^ path ^ " " ^ string_of_int line ^ ":" + ^ string_of_int col); + let currentFile = createCurrentFile () in + hover ~supportsMarkdownLinks:true ~path ~pos:(line, col) + ~currentFile ~debug:true; + Sys.remove currentFile + | "she" -> + print_endline + ("Signature help " ^ path ^ " " ^ string_of_int line ^ ":" + ^ string_of_int col); + let currentFile = createCurrentFile () in + signatureHelp ~path ~pos:(line, col) ~currentFile ~debug:true + ~allowForConstructorPayloads:true; + Sys.remove currentFile + | "int" -> + print_endline ("Create Interface " ^ path); + let cmiFile = + let open Filename in + let ( ++ ) = concat in + let name = chop_extension (basename path) ^ ".cmi" in + let dir = dirname path in + dir ++ parent_dir_name ++ "lib" ++ "bs" ++ "src" ++ name + in + Printf.printf "%s" (CreateInterface.command ~path ~cmiFile) + | "ref" -> + print_endline + ("References " ^ path ^ " " ^ string_of_int line ^ ":" + ^ string_of_int col); + references ~path ~pos:(line, col) ~debug:true + | "pre" -> + print_endline + ("PrepareRename " ^ path ^ " " ^ string_of_int line ^ ":" + ^ string_of_int col); + prepareRename ~path ~pos:(line, col) ~debug:true + | "ren" -> + let newName = String.sub rest 4 (len - mlen - 4) in + let () = + print_endline + ("Rename " ^ path ^ " " ^ string_of_int line ^ ":" + ^ string_of_int col ^ " " ^ newName) + in + rename ~path ~pos:(line, col) ~newName ~debug:true + | "typ" -> + print_endline + ("TypeDefinition " ^ path ^ " " ^ string_of_int line ^ ":" + ^ string_of_int col); + typeDefinition ~path ~pos:(line, col) ~debug:true + | "xfm" -> + let currentFile = createCurrentFile () in + (* +2 is to ensure that the character ^ points to is what's considered the end of the selection. *) + let endCol = col + try String.index rest '^' + 2 with _ -> 0 in + let endPos = (line, endCol) in + let startPos = (line, col) in + if startPos = endPos then + print_endline + ("Xform " ^ path ^ " " ^ string_of_int line ^ ":" + ^ string_of_int col) + else + print_endline + ("Xform " ^ path ^ " start: " ^ Pos.toString startPos + ^ ", end: " ^ Pos.toString endPos); + + let source = + Files.readFile currentFile |> Option.value ~default:"" + in + let kindFile = Files.classifySourceFile currentFile in + let codeActions = + Xform.extractCodeActions ~path ~startPos ~endPos ~source ~kindFile + ~debug:true + in + Sys.remove currentFile; + codeActions + |> List.iter (fun {Protocol.title; edit = {documentChanges}} -> + Printf.printf "Hit: %s\n" title; + documentChanges + |> List.iter (fun dc -> + match dc with + | Protocol.TextDocumentEdit tde -> + Printf.printf "\nTextDocumentEdit: %s\n" + tde.textDocument.uri; + + tde.edits + |> List.iter (fun {Protocol.range; newText} -> + let indent = + String.make range.start.character ' ' + in + Printf.printf + "%s\nnewText:\n%s<--here\n%s%s\n" + (Protocol.stringifyRange range) + indent indent newText) + | CreateFile cf -> + Printf.printf "\nCreateFile: %s\n" cf.uri)) + | "c-a" -> + let hint = String.sub rest 3 (String.length rest - 3) in + print_endline + ("Codemod AddMissingCases" ^ path ^ " " ^ string_of_int line ^ ":" + ^ string_of_int col); + let source = Files.readFile path |> Option.value ~default:"" in + Codemod.transform ~source ~pos:(line, col) ~debug:true + ~typ:AddMissingCases ~hint + |> print_endline + | "dia" -> diagnosticSyntax ~path + | "hin" -> + (* Get all inlay Hint between line 1 and n. + Don't get the first line = 0. + *) + let line_start = 1 in + let line_end = 34 in + print_endline + ("Inlay Hint " ^ path ^ " " ^ string_of_int line_start ^ ":" + ^ string_of_int line_end); + inlayhint ~path ~pos:(line_start, line_end) ~maxLength:"25" + ~debug:false + | "cle" -> + print_endline ("Code Lens " ^ path); + codeLens ~path ~debug:false + | "ast" -> + print_endline + ("Dump AST " ^ path ^ " " ^ string_of_int line ^ ":" + ^ string_of_int col); + let currentFile = createCurrentFile () in + DumpAst.dump ~pos:(line, col) ~currentFile; + Sys.remove currentFile + | "sem" -> semanticTokens ~path + | _ -> ()); + print_newline ()) + in + lines |> List.iteri processLine diff --git a/analysis/src/Codemod.ml b/analysis/src/Codemod.ml index 5c273637def..970dfb79413 100644 --- a/analysis/src/Codemod.ml +++ b/analysis/src/Codemod.ml @@ -5,8 +5,8 @@ let rec collectPatterns p = | Ppat_or (p1, p2) -> collectPatterns p1 @ [p2] | _ -> [p] -let transform ~path ~pos ~debug ~typ ~hint = - let structure, printExpr, _, _ = Xform.parseImplementation ~filename:path in +let transform ~source ~pos ~debug ~typ ~hint = + let structure, printExpr, _, _ = Xform.parseImplementation ~source in match typ with | AddMissingCases -> ( let source = "let " ^ hint ^ " = ()" in diff --git a/analysis/src/Commands.ml b/analysis/src/Commands.ml index 40799348ec5..6f728d767ff 100644 --- a/analysis/src/Commands.ml +++ b/analysis/src/Commands.ml @@ -1,17 +1,13 @@ -let completion ~debug ~path ~pos ~currentFile = - let completions = - match - Completions.getCompletions ~debug ~path ~pos ~currentFile ~forHover:false - with - | None -> [] - | Some (completions, full, _) -> - completions - |> List.map (CompletionBackEnd.completionToItem ~full) - |> List.map Protocol.stringifyCompletionItem - in - completions |> Protocol.array |> print_endline +let completion ~debug ~source ~kindFile ~pos ~full = + match + Completions.getCompletions ~debug ~source ~kindFile ~pos ~full + ~forHover:false + with + | None -> [] + | Some (completions, full, _) -> + completions |> List.map (CompletionBackEnd.completionToItem ~full) -let completionResolve ~path ~modulePath = +let completionResolve ~(full : SharedTypes.full option) ~modulePath = (* We ignore the internal module path as of now because there's currently no use case for it. But, if we wanted to move resolving documentation for regular modules and not just file modules to the completionResolve @@ -23,44 +19,26 @@ let completionResolve ~path ~modulePath = | [] -> raise (Failure "Invalid module path.") in let docstring = - match Cmt.loadFullCmtFromPath ~path with + match full with | None -> if Debug.verbose () then Printf.printf "[completion_resolve] Could not load cmt\n"; - Protocol.null + None | Some full -> ( match ProcessCmt.fileForModule ~package:full.package moduleName with | None -> if Debug.verbose () then Printf.printf "[completion_resolve] Did not find file for module %s\n" moduleName; - Protocol.null - | Some file -> - file.structure.docstring |> String.concat "\n\n" - |> Protocol.wrapInQuotes) - in - print_endline docstring - -let inlayhint ~path ~pos ~maxLength ~debug = - let result = - match Hint.inlay ~path ~pos ~maxLength ~debug with - | Some hints -> hints |> Protocol.array - | None -> Protocol.null + None + | Some file -> Some (file.structure.docstring |> String.concat "\n\n")) in - print_endline result + docstring -let codeLens ~path ~debug = +let hover ~source ~kindFile ~pos ~supportsMarkdownLinks ~full ~debug = let result = - match Hint.codeLens ~path ~debug with - | Some lens -> lens |> Protocol.array - | None -> Protocol.null - in - print_endline result - -let hover ~path ~pos ~currentFile ~debug ~supportsMarkdownLinks = - let result = - match Cmt.loadFullCmtFromPath ~path with - | None -> Protocol.null + match full with + | None -> None | Some full -> ( match References.getLocItem ~full ~pos ~debug with | None -> ( @@ -68,12 +46,12 @@ let hover ~path ~pos ~currentFile ~debug ~supportsMarkdownLinks = Printf.printf "Nothing at that position. Now trying to use completion.\n"; match - Hover.getHoverViaCompletions ~debug ~path ~pos ~currentFile - ~forHover:true ~supportsMarkdownLinks + Hover.getHoverViaCompletions ~debug ~source ~kindFile ~pos + ~forHover:true ~supportsMarkdownLinks ~full:(Some full) with - | None -> Protocol.null - | Some hover -> hover) - | Some locItem -> ( + | None -> None + | Some hover -> Some hover) + | Some locItem -> let isModule = match locItem.locType with | LModule _ | TopLevelModule _ -> true @@ -91,34 +69,24 @@ let hover ~path ~pos ~currentFile ~debug ~supportsMarkdownLinks = (* 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 Protocol.null - else - let hoverText = Hover.newHover ~supportsMarkdownLinks ~full locItem in - match hoverText with - | None -> Protocol.null - | Some s -> Protocol.stringifyHover s)) + if skipZero then None + else Hover.newHover ~supportsMarkdownLinks ~full locItem) in - print_endline result + result -let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads = - let result = - match - SignatureHelp.signatureHelp ~path ~pos ~currentFile ~debug - ~allowForConstructorPayloads - with - | None -> - {Protocol.signatures = []; activeSignature = None; activeParameter = None} - | Some res -> res - in - print_endline (Protocol.stringifySignatureHelp result) - -let codeAction ~path ~startPos ~endPos ~currentFile ~debug = - Xform.extractCodeActions ~path ~startPos ~endPos ~currentFile ~debug - |> CodeActions.stringifyCodeActions |> print_endline +let signatureHelp ~source ~kindFile ~pos ~allowForConstructorPayloads ~full + ~debug = + match + SignatureHelp.signatureHelp ~debug ~source ~kindFile ~pos + ~allowForConstructorPayloads ~full + with + | None -> + {Protocol.signatures = []; activeSignature = None; activeParameter = None} + | Some res -> res -let definition ~path ~pos ~debug = +let definition ~full ~pos ~debug = let locationOpt = - match Cmt.loadFullCmtFromPath ~path with + match full with | None -> None | Some full -> ( match References.getLocItem ~full ~pos ~debug with @@ -150,14 +118,11 @@ let definition ~path ~pos ~debug = } | Some _ -> None)) in - print_endline - (match locationOpt with - | None -> Protocol.null - | Some location -> location |> Protocol.stringifyLocation) + locationOpt -let typeDefinition ~path ~pos ~debug = +let typeDefinition ~full ~pos ~debug = let maybeLocation = - match Cmt.loadFullCmtFromPath ~path with + match full with | None -> None | Some full -> ( match References.getLocItem ~full ~pos ~debug with @@ -172,14 +137,11 @@ let typeDefinition ~path ~pos ~debug = range = Utils.cmtLocToRange loc; })) in - print_endline - (match maybeLocation with - | None -> Protocol.null - | Some location -> location |> Protocol.stringifyLocation) + maybeLocation -let references ~path ~pos ~debug = +let references ~full ~pos ~debug = let allLocs = - match Cmt.loadFullCmtFromPath ~path with + match full with | None -> [] | Some full -> ( match References.getLocItem ~full ~pos ~debug with @@ -194,22 +156,23 @@ let references ~path ~pos ~debug = | Some loc -> loc | None -> Uri.toTopLevelLoc uri2 in - Protocol.stringifyLocation - {uri = Uri.toString uri2; range = Utils.cmtLocToRange loc} + + { + Protocol.uri = Uri.toString uri2; + range = Utils.cmtLocToRange loc; + } :: acc) []) in - print_endline - (if allLocs = [] then Protocol.null - else "[\n" ^ (allLocs |> String.concat ",\n") ^ "\n]") + allLocs -let rename ~path ~pos ~newName ~debug = +let rename ~full ~pos ~newName ~debug = let result = - match Cmt.loadFullCmtFromPath ~path with - | None -> Protocol.null + match full with + | None -> None | Some full -> ( match References.getLocItem ~full ~pos ~debug with - | None -> Protocol.null + | None -> None | Some locItem -> let allReferences = References.allReferencesForLocItem ~full locItem in let referencesToToplevelModules = @@ -263,24 +226,16 @@ let rename ~path ~pos ~newName ~debug = textDocumentEdit :: acc) textEditsByUri [] in - let fileRenamesString = - fileRenames |> List.map Protocol.stringifyRenameFile - in - let textDocumentEditsString = - textDocumentEdits |> List.map Protocol.stringifyTextDocumentEdit - in - "[\n" - ^ (fileRenamesString @ textDocumentEditsString |> String.concat ",\n") - ^ "\n]") + Some (fileRenames, textDocumentEdits)) in - print_endline result + result -let prepareRename ~path ~pos ~debug = - match Cmt.loadFullCmtFromPath ~path with - | None -> print_endline Protocol.null +let prepareRename ~full ~pos ~debug = + match full with + | None -> None | Some full -> ( match References.getLocItem ~full ~pos ~debug with - | None -> print_endline Protocol.null + | None -> None | Some locItem -> let range = Utils.cmtLocToRange locItem.loc in let placeholderOpt = @@ -290,245 +245,37 @@ let prepareRename ~path ~pos ~debug = Some name | _ -> None in - let fields = - [("range", Some (Protocol.stringifyRange range))] - @ - match placeholderOpt with - | None -> [] - | Some s -> [("placeholder", Some (Protocol.wrapInQuotes s))] - in - print_endline (Protocol.stringifyObject fields)) + Some + (match placeholderOpt with + | None -> Protocol.Range range + | Some placeholder -> Protocol.Placeholder {range; placeholder})) -let format ~path = - if Filename.check_suffix path ".res" then - let {Res_driver.parsetree = structure; comments; diagnostics} = - Res_driver.parsing_engine.parse_implementation ~for_printer:true - ~filename:path - in - if List.length diagnostics > 0 then "" - else Res_printer.print_implementation ~comments structure - else if Filename.check_suffix path ".resi" then - let {Res_driver.parsetree = signature; comments; diagnostics} = - Res_driver.parsing_engine.parse_interface ~for_printer:true ~filename:path - in - if List.length diagnostics > 0 then "" - else Res_printer.print_interface ~comments signature - else "" - -let diagnosticSyntax ~path = - print_endline (Diagnostics.document_syntax ~path |> Protocol.array) +let format ~source ~kindFile = + let max = String.length source in + let range = + Protocol. + {start = {line = 0; character = 0}; end_ = {line = max; character = max}} + in -let test ~path = - Uri.stripPath := true; - match Files.readFile path with - | None -> assert false - | Some text -> - let lines = text |> String.split_on_char '\n' in - let processLine i line = - let createCurrentFile () = - let currentFile, cout = - Filename.open_temp_file "def" ("txt." ^ Filename.extension path) - in - let removeLineComment l = - let len = String.length l in - let rec loop i = - if i + 2 <= len && l.[i] = '/' && l.[i + 1] = '/' then Some (i + 2) - else if i + 2 < len && l.[i] = ' ' then loop (i + 1) - else None - in - match loop 0 with - | None -> l - | Some indexAfterComment -> - String.make indexAfterComment ' ' - ^ String.sub l indexAfterComment (len - indexAfterComment) - in - lines - |> List.iteri (fun j l -> - let lineToOutput = - if j == i - 1 then removeLineComment l else l - in - Printf.fprintf cout "%s\n" lineToOutput); - close_out cout; - currentFile + let result = + match kindFile with + | Files.Res -> + let {Res_driver.parsetree = structure; comments; diagnostics} = + Res_driver.parsing_engine.parse_implementation_from_source + ~for_printer:true ~source in - if Str.string_match (Str.regexp "^ *//[ ]*\\^") line 0 then - let matched = Str.matched_string line in - let len = line |> String.length in - let mlen = String.length matched in - let rest = String.sub line mlen (len - mlen) in - let line = i - 1 in - let col = mlen - 1 in - if mlen >= 3 then ( - (match String.sub rest 0 3 with - | "db+" -> Log.verbose := true - | "db-" -> Log.verbose := false - | "dv+" -> Debug.debugLevel := Verbose - | "dv-" -> Debug.debugLevel := Off - | "in+" -> Cfg.inIncrementalTypecheckingMode := true - | "in-" -> Cfg.inIncrementalTypecheckingMode := false - | "ve+" -> ( - let version = String.sub rest 3 (String.length rest - 3) in - let version = String.trim version in - if Debug.verbose () then - Printf.printf "Setting version: %s\n" version; - match String.split_on_char '.' version with - | [majorRaw; minorRaw] -> - let version = (int_of_string majorRaw, int_of_string minorRaw) in - Packages.overrideRescriptVersion := Some version - | _ -> ()) - | "ve-" -> Packages.overrideRescriptVersion := None - | "def" -> - print_endline - ("Definition " ^ path ^ " " ^ string_of_int line ^ ":" - ^ string_of_int col); - definition ~path ~pos:(line, col) ~debug:true - | "com" -> - print_endline - ("Complete " ^ path ^ " " ^ string_of_int line ^ ":" - ^ string_of_int col); - let currentFile = createCurrentFile () in - completion ~debug:true ~path ~pos:(line, col) ~currentFile; - Sys.remove currentFile - | "cre" -> - let modulePath = String.sub rest 3 (String.length rest - 3) in - let modulePath = String.trim modulePath in - print_endline ("Completion resolve: " ^ modulePath); - completionResolve ~path ~modulePath - | "dce" -> - print_endline ("DCE " ^ path); - Reanalyze.RunConfig.runConfig.suppress <- ["src"]; - Reanalyze.RunConfig.runConfig.unsuppress <- - [Filename.concat "src" "dce"]; - DceCommand.command () - | "doc" -> - print_endline ("DocumentSymbol " ^ path); - DocumentSymbol.command ~path - | "hig" -> - print_endline ("Highlight " ^ path); - SemanticTokens.command ~debug:true - ~emitter:(SemanticTokens.Token.createEmitter ()) - ~path - | "hov" -> - print_endline - ("Hover " ^ path ^ " " ^ string_of_int line ^ ":" - ^ string_of_int col); - let currentFile = createCurrentFile () in - hover ~supportsMarkdownLinks:true ~path ~pos:(line, col) - ~currentFile ~debug:true; - Sys.remove currentFile - | "she" -> - print_endline - ("Signature help " ^ path ^ " " ^ string_of_int line ^ ":" - ^ string_of_int col); - let currentFile = createCurrentFile () in - signatureHelp ~path ~pos:(line, col) ~currentFile ~debug:true - ~allowForConstructorPayloads:true; - Sys.remove currentFile - | "int" -> - print_endline ("Create Interface " ^ path); - let cmiFile = - let open Filename in - let ( ++ ) = concat in - let name = chop_extension (basename path) ^ ".cmi" in - let dir = dirname path in - dir ++ parent_dir_name ++ "lib" ++ "bs" ++ "src" ++ name - in - Printf.printf "%s" (CreateInterface.command ~path ~cmiFile) - | "ref" -> - print_endline - ("References " ^ path ^ " " ^ string_of_int line ^ ":" - ^ string_of_int col); - references ~path ~pos:(line, col) ~debug:true - | "pre" -> - print_endline - ("PrepareRename " ^ path ^ " " ^ string_of_int line ^ ":" - ^ string_of_int col); - prepareRename ~path ~pos:(line, col) ~debug:true - | "ren" -> - let newName = String.sub rest 4 (len - mlen - 4) in - let () = - print_endline - ("Rename " ^ path ^ " " ^ string_of_int line ^ ":" - ^ string_of_int col ^ " " ^ newName) - in - rename ~path ~pos:(line, col) ~newName ~debug:true - | "typ" -> - print_endline - ("TypeDefinition " ^ path ^ " " ^ string_of_int line ^ ":" - ^ string_of_int col); - typeDefinition ~path ~pos:(line, col) ~debug:true - | "xfm" -> - let currentFile = createCurrentFile () in - (* +2 is to ensure that the character ^ points to is what's considered the end of the selection. *) - let endCol = col + try String.index rest '^' + 2 with _ -> 0 in - let endPos = (line, endCol) in - let startPos = (line, col) in - if startPos = endPos then - print_endline - ("Xform " ^ path ^ " " ^ string_of_int line ^ ":" - ^ string_of_int col) - else - print_endline - ("Xform " ^ path ^ " start: " ^ Pos.toString startPos - ^ ", end: " ^ Pos.toString endPos); - let codeActions = - Xform.extractCodeActions ~path ~startPos ~endPos ~currentFile - ~debug:true - in - Sys.remove currentFile; - codeActions - |> List.iter (fun {Protocol.title; edit = {documentChanges}} -> - Printf.printf "Hit: %s\n" title; - documentChanges - |> List.iter (fun dc -> - match dc with - | Protocol.TextDocumentEdit tde -> - Printf.printf "\nTextDocumentEdit: %s\n" - tde.textDocument.uri; + if List.length diagnostics > 0 then Error "Document has syntax errors" + else Ok (Res_printer.print_implementation ~comments structure) + | Resi -> + let {Res_driver.parsetree = signature; comments; diagnostics} = + Res_driver.parsing_engine.parse_interface_from_source ~for_printer:true + ~source + in + if List.length diagnostics > 0 then Error "Document has syntax errors" + else Ok (Res_printer.print_interface ~comments signature) + | Other -> Error "Failed to format, file not supported" + in - tde.edits - |> List.iter (fun {Protocol.range; newText} -> - let indent = - String.make range.start.character ' ' - in - Printf.printf - "%s\nnewText:\n%s<--here\n%s%s\n" - (Protocol.stringifyRange range) - indent indent newText) - | CreateFile cf -> - Printf.printf "\nCreateFile: %s\n" cf.uri)) - | "c-a" -> - let hint = String.sub rest 3 (String.length rest - 3) in - print_endline - ("Codemod AddMissingCases" ^ path ^ " " ^ string_of_int line ^ ":" - ^ string_of_int col); - Codemod.transform ~path ~pos:(line, col) ~debug:true - ~typ:AddMissingCases ~hint - |> print_endline - | "dia" -> diagnosticSyntax ~path - | "hin" -> - (* Get all inlay Hint between line 1 and n. - Don't get the first line = 0. - *) - let line_start = 1 in - let line_end = 34 in - print_endline - ("Inlay Hint " ^ path ^ " " ^ string_of_int line_start ^ ":" - ^ string_of_int line_end); - inlayhint ~path ~pos:(line_start, line_end) ~maxLength:"25" - ~debug:false - | "cle" -> - print_endline ("Code Lens " ^ path); - codeLens ~path ~debug:false - | "ast" -> - print_endline - ("Dump AST " ^ path ^ " " ^ string_of_int line ^ ":" - ^ string_of_int col); - let currentFile = createCurrentFile () in - DumpAst.dump ~pos:(line, col) ~currentFile; - Sys.remove currentFile - | "sem" -> SemanticTokens.semanticTokens ~currentFile:path - | _ -> ()); - print_newline ()) - in - lines |> List.iteri processLine + match result with + | Ok newText -> Ok [Protocol.{range; newText}] + | Error e -> Error e diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml index cba2cbfad1a..cdb879290dc 100644 --- a/analysis/src/CompletionFrontEnd.ml +++ b/analysis/src/CompletionFrontEnd.ml @@ -352,8 +352,8 @@ let completePipeChain ~(inJsxContext : bool) (exp : Parsetree.expression) = |> Option.map (fun ctxPath -> (ctxPath, pexp_loc)) | _ -> None -let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor - ?findThisExprLoc text = +let completionWithParser1 ~debug ~offset ~posCursor ~kindFile ?findThisExprLoc + text = let offsetNoWhite = Utils.skipWhite text (offset - 1) in let posNoWhite = let line, col = posCursor in @@ -1783,12 +1783,12 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor } in - if Filename.check_suffix path ".res" then ( + if kindFile = Files.Res then ( let parser = Res_driver.parsing_engine.parse_implementation_from_source ~for_printer:false in - let {Res_driver.parsetree = str} = parser ~source:currentFile in + let {Res_driver.parsetree = str} = parser ~source:text in iterator.structure iterator str |> ignore; if blankAfterCursor = Some ' ' || blankAfterCursor = Some '\n' then ( scope := !lastScopeBeforeCursor; @@ -1797,9 +1797,11 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor (CPId {loc = Location.none; path = [""]; completionContext = Value}))); if !found = false then if debug then Printf.printf "XXX Not found!\n"; !result) - else if Filename.check_suffix path ".resi" then ( - let parser = Res_driver.parsing_engine.parse_interface ~for_printer:false in - let {Res_driver.parsetree = signature} = parser ~filename:currentFile in + else if kindFile = Resi then ( + let parser = + Res_driver.parsing_engine.parse_interface_from_source ~for_printer:false + in + let {Res_driver.parsetree = signature} = parser ~source:text in iterator.signature iterator signature |> ignore; if blankAfterCursor = Some ' ' || blankAfterCursor = Some '\n' then ( scope := !lastScopeBeforeCursor; @@ -1810,19 +1812,18 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor !result) else None -let completionWithParser ~debug ~path ~posCursor ~currentFile ~text = - match Pos.positionToOffset text posCursor with +let completionWithParser ~debug ~source ~kindFile ~posCursor = + match Pos.positionToOffset source posCursor with | Some offset -> - completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor text + completionWithParser1 ~debug ~offset ~posCursor ~kindFile source | None -> None -let findTypeOfExpressionAtLoc ~debug ~path ~posCursor ~currentFile loc = - let textOpt = Files.readFile currentFile in - match textOpt with - | None | Some "" -> None - | Some text -> ( - match Pos.positionToOffset text posCursor with +let findTypeOfExpressionAtLoc ~debug ~posCursor ~source ~kindFile loc = + match source with + | "" -> None + | source -> ( + match Pos.positionToOffset source posCursor with | Some offset -> - completionWithParser1 ~findThisExprLoc:loc ~currentFile ~debug ~offset - ~path ~posCursor text + completionWithParser1 ~findThisExprLoc:loc ~debug ~offset ~posCursor + ~kindFile source | None -> None) diff --git a/analysis/src/Completions.ml b/analysis/src/Completions.ml index c11d51673ee..ae35a5a0d34 100644 --- a/analysis/src/Completions.ml +++ b/analysis/src/Completions.ml @@ -1,11 +1,11 @@ -let getCompletions ~debug ~path ~pos ~currentFile ~forHover = - let textOpt = Files.readFile currentFile in - match textOpt with - | None | Some "" -> None - | Some text -> ( +let getCompletions ~debug ~source ~kindFile ~pos ~forHover + ~(full : SharedTypes.full option) = + match source with + | "" -> None + | source -> ( match - CompletionFrontEnd.completionWithParser ~debug ~path ~posCursor:pos - ~currentFile ~text + CompletionFrontEnd.completionWithParser ~debug ~source ~kindFile + ~posCursor:pos with | None -> None | Some (completable, scope) -> ( @@ -18,7 +18,7 @@ let getCompletions ~debug ~path ~pos ~currentFile ~forHover = scope; print_newline ()); (* Only perform expensive ast operations if there are completables *) - match Cmt.loadFullCmtFromPath ~path with + match full with | None -> None | Some full -> let env = SharedTypes.QueryEnv.fromFile full.file in diff --git a/analysis/src/Diagnostics.ml b/analysis/src/Diagnostics.ml index 0b30d0e3321..970936c022b 100644 --- a/analysis/src/Diagnostics.ml +++ b/analysis/src/Diagnostics.ml @@ -1,4 +1,4 @@ -let document_syntax ~path = +let document_syntax ~source ~kindFile = let get_diagnostics diagnostics = diagnostics |> List.map (fun diagnostic -> @@ -8,7 +8,7 @@ let document_syntax ~path = let _, endline, endcol = Location.get_pos_info (Res_diagnostics.get_end_pos diagnostic) in - Protocol.stringifyDiagnostic + Protocol. { range = { @@ -19,16 +19,16 @@ let document_syntax ~path = severity = 1; }) in - if FindFiles.isImplementation path then + if kindFile = Files.Res then let parseImplementation = - Res_driver.parsing_engine.parse_implementation ~for_printer:false - ~filename:path + Res_driver.parsing_engine.parse_implementation_from_source + ~for_printer:false ~source in get_diagnostics parseImplementation.diagnostics - else if FindFiles.isInterface path then + else if kindFile = Files.Resi then let parseInterface = - Res_driver.parsing_engine.parse_interface ~for_printer:false - ~filename:path + Res_driver.parsing_engine.parse_interface_from_source ~for_printer:false + ~source in get_diagnostics parseInterface.diagnostics else [] diff --git a/analysis/src/Hint.ml b/analysis/src/Hint.ml index 71b1b7cfe3a..81881be3bc0 100644 --- a/analysis/src/Hint.ml +++ b/analysis/src/Hint.ml @@ -31,7 +31,7 @@ let locItemToTypeHint ~full:{file; package} locItem = | `Field -> fromType t)) | _ -> None -let inlay ~path ~pos ~maxLength ~debug = +let inlay ~source ~kindFile ~pos ~maxLength ~full ~debug = let maxlen = try Some (int_of_string maxLength) with Failure _ -> None in let hints = ref [] in let start_line, end_line = pos in @@ -71,13 +71,14 @@ let inlay ~path ~pos ~maxLength ~debug = Ast_iterator.default_iterator.value_binding iterator vb in let iterator = {Ast_iterator.default_iterator with value_binding} in - (if Files.classifySourceFile path = Res then + (if kindFile = Files.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 = structure} = parser ~filename:path in + let {Res_driver.parsetree = structure} = parser ~source in iterator.structure iterator structure |> ignore); - match Cmt.loadFullCmtFromPath ~path with + match full with | None -> None | Some full -> let result = @@ -96,7 +97,7 @@ let inlay ~path ~pos ~maxLength ~debug = match locItemToTypeHint locItem ~full with | Some label -> ( let result = - Protocol.stringifyHint + Protocol. { kind = inlayKindToNumber hintKind; position; @@ -113,7 +114,7 @@ let inlay ~path ~pos ~maxLength ~debug = in Some result -let codeLens ~path ~debug = +let codeLens ~source ~kindFile ~full ~debug = let lenses = ref [] in let push loc = let range = Utils.cmtLocToRange loc in @@ -135,13 +136,14 @@ let codeLens ~path ~debug = let iterator = {Ast_iterator.default_iterator with value_binding} in (* We only print code lenses in implementation files. This is because they'd be redundant in interface files, where the definition itself will be the same thing as what would've been printed in the code lens. *) - (if Files.classifySourceFile path = Res then + (if kindFile = Files.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 = structure} = parser ~filename:path in + let {Res_driver.parsetree = structure} = parser ~source in iterator.structure iterator structure |> ignore); - match Cmt.loadFullCmtFromPath ~path with + match full with | None -> None | Some full -> let result = @@ -154,21 +156,21 @@ let codeLens ~path ~debug = with | Some {locType = Typed (_, typeExpr, _)} -> Some - (Protocol.stringifyCodeLens - { - range; - command = - Some - { - (* Code lenses can run commands. An empty command string means we just want the editor + Protocol. + { + range; + command = + Some + { + (* Code lenses can run commands. An empty command string means we just want the editor to print the text, not link to running a command. *) - command = ""; - (* Print the type with a huge line width, because the code lens always prints on a + command = ""; + (* Print the type with a huge line width, because the code lens always prints on a single line in the editor. *) - title = - typeExpr |> Shared.typeToString ~lineWidth:400; - }; - }) + title = + typeExpr |> Shared.typeToString ~lineWidth:400; + }; + } | _ -> None) in Some result diff --git a/analysis/src/Hover.ml b/analysis/src/Hover.ml index 716f5e3c002..4f1a98da27f 100644 --- a/analysis/src/Hover.ml +++ b/analysis/src/Hover.ml @@ -180,9 +180,11 @@ let hoverWithExpandedTypes ~file ~package ~supportsMarkdownLinks ?docstring (* 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 Completions.getCompletions ~debug ~path ~pos ~currentFile ~forHover with +let getHoverViaCompletions ~debug ~source ~kindFile ~pos ~forHover + ~supportsMarkdownLinks ~full = + match + Completions.getCompletions ~debug ~source ~kindFile ~pos ~forHover ~full + with | None -> None | Some (completions, ({file; package} as full), scope) -> ( let rawOpens = Scope.getRawOpens scope in @@ -193,7 +195,7 @@ let getHoverViaCompletions ~debug ~path ~pos ~currentFile ~forHover @ if typString = "" then [] else [Markdown.codeBlock typString] in - Some (Protocol.stringifyHover (String.concat "\n\n" parts)) + Some (String.concat "\n\n" parts) | {kind = Field _; env; docstring} :: _ -> ( let opens = CompletionBackEnd.getOpens ~debug ~rawOpens ~package ~env in match @@ -205,7 +207,7 @@ let getHoverViaCompletions ~debug ~path ~pos ~currentFile ~forHover hoverWithExpandedTypes ~file ~package ~docstring ~supportsMarkdownLinks typ in - Some (Protocol.stringifyHover typeString) + Some typeString | None -> None) | {env} :: _ -> ( let opens = CompletionBackEnd.getOpens ~debug ~rawOpens ~package ~env in @@ -217,7 +219,7 @@ let getHoverViaCompletions ~debug ~path ~pos ~currentFile ~forHover let typeString = hoverWithExpandedTypes ~file ~package ~supportsMarkdownLinks typ in - Some (Protocol.stringifyHover typeString) + Some typeString | None -> None) | _ -> None) diff --git a/analysis/src/Protocol.ml b/analysis/src/Protocol.ml index e3e4208628e..447584b7e9b 100644 --- a/analysis/src/Protocol.ml +++ b/analysis/src/Protocol.ml @@ -63,6 +63,10 @@ type documentSymbolItem = { range: range; children: documentSymbolItem list; } +type prepareRenameWithPlaceholder = {range: range; placeholder: string} +type prepareRename = + | Range of range + | Placeholder of prepareRenameWithPlaceholder type renameFile = {oldUri: string; newUri: string} type diagnostic = {range: range; message: string; severity: int} @@ -92,6 +96,8 @@ type codeAction = { edit: codeActionEdit; } +type semanticTokens = {data: int array} + let wrapInQuotes s = "\"" ^ Json.escape s ^ "\"" let null = "null" @@ -105,6 +111,15 @@ let stringifyRange r = (stringifyPosition r.start) (stringifyPosition r.end_) +let stringifyRangeWithPlaceholder (r : prepareRenameWithPlaceholder) = + Printf.sprintf + {|{ + "range": %s, + "placeholder": %s + }|} + (stringifyRange r.range) + (wrapInQuotes r.placeholder) + let stringifyTextEdit (te : textEdit) = Printf.sprintf {|{ diff --git a/analysis/src/SemanticTokens.ml b/analysis/src/SemanticTokens.ml index ddccba9b2b1..94895188a29 100644 --- a/analysis/src/SemanticTokens.ml +++ b/analysis/src/SemanticTokens.ml @@ -29,15 +29,15 @@ module Token = struct | Property (** {x:...} *) | JsxLowercase (** div in
*) - let tokenTypeToString = function - | Operator -> "0" - | Variable -> "1" - | Type -> "2" - | JsxTag -> "3" - | Namespace -> "4" - | EnumMember -> "5" - | Property -> "6" - | JsxLowercase -> "7" + let tokenTypeToInt = function + | Operator -> 0 + | Variable -> 1 + | Type -> 2 + | JsxTag -> 3 + | Namespace -> 4 + | EnumMember -> 5 + | Property -> 6 + | JsxLowercase -> 7 let tokenTypeDebug = function | Operator -> "Operator" @@ -64,25 +64,14 @@ module Token = struct let add ~line ~char ~length ~type_ e = e.tokens <- (line, char, length, type_) :: e.tokens - let emitToken buf (line, char, length, type_) e = + let emitToken (line, char, length, type_) e = let deltaLine = line - e.lastLine in let deltaChar = if deltaLine = 0 then char - e.lastChar else char in e.lastLine <- line; e.lastChar <- char; - if Buffer.length buf > 0 then Buffer.add_char buf ','; - if - deltaLine >= 0 && deltaChar >= 0 && length >= 0 - (* Defensive programming *) - then - Buffer.add_string buf - (string_of_int deltaLine ^ "," ^ string_of_int deltaChar ^ "," - ^ string_of_int length ^ "," ^ tokenTypeToString type_ ^ "," - ^ tokenModifiersString) - - let remove_trailing_comma buffer = - let len = Buffer.length buffer in - if len > 0 && Buffer.nth buffer (len - 1) = ',' then - Buffer.truncate buffer (len - 1) + if deltaLine >= 0 && deltaChar >= 0 && length >= 0 then + Some [|deltaLine; deltaChar; length; tokenTypeToInt type_; 0|] + else None let emit e = let sortedTokens = @@ -90,13 +79,12 @@ module Token = struct |> List.sort (fun (l1, c1, _, _) (l2, c2, _, _) -> if l1 = l2 then compare c1 c2 else compare l1 l2) in - let buf = Buffer.create 1 in - sortedTokens |> List.iter (fun t -> e |> emitToken buf t); + let arrays = sortedTokens |> List.filter_map (fun t -> e |> emitToken t) in + Array.concat arrays - (* Valid JSON arrays cannot have trailing commas *) - remove_trailing_comma buf; - - Buffer.contents buf + let arrayToJsonString arr = + let items = Array.map string_of_int arr |> Array.to_list in + "[" ^ String.concat "," items ^ "]" end let isLowercaseId id = @@ -203,7 +191,7 @@ let emitVariant ~(name : Longident.t Location.loc) ~debug emitter = |> emitLongident ~lastToken:(Some Token.EnumMember) ~pos:(Loc.start name.loc) ~lid:name.txt ~debug -let command ~debug ~emitter ~path = +let command ~debug ~emitter ~source ~kindFile = let processTypeArg (coreType : Parsetree.core_type) = if debug then Printf.printf "TypeArg: %s\n" (Loc.toString coreType.ptyp_loc) in @@ -480,28 +468,27 @@ let command ~debug ~emitter ~path = } in - if Files.classifySourceFile path = Res then ( + if kindFile = Files.Res then ( let parser = - Res_driver.parsing_engine.parse_implementation ~for_printer:false - in - let {Res_driver.parsetree = structure; diagnostics} = - parser ~filename:path + Res_driver.parsing_engine.parse_implementation_from_source + ~for_printer:false in + let {Res_driver.parsetree = structure; diagnostics} = parser ~source in if debug then Printf.printf "structure items:%d diagnostics:%d \n" (List.length structure) (List.length diagnostics); iterator.structure iterator structure |> ignore) else - let parser = Res_driver.parsing_engine.parse_interface ~for_printer:false in - let {Res_driver.parsetree = signature; diagnostics} = - parser ~filename:path + let parser = + Res_driver.parsing_engine.parse_interface_from_source ~for_printer:false in + let {Res_driver.parsetree = signature; diagnostics} = parser ~source in if debug then Printf.printf "signature items:%d diagnostics:%d \n" (List.length signature) (List.length diagnostics); iterator.signature iterator signature |> ignore -let semanticTokens ~currentFile = +let semanticTokens ~source ~kindFile = let emitter = Token.createEmitter () in - command ~emitter ~debug:false ~path:currentFile; - Printf.printf "{\"data\":[%s]}" (Token.emit emitter) + command ~emitter ~debug:false ~source ~kindFile; + Protocol.{data = Token.emit emitter} diff --git a/analysis/src/SignatureHelp.ml b/analysis/src/SignatureHelp.ml index e4c9cb11ae1..68cfc405906 100644 --- a/analysis/src/SignatureHelp.ml +++ b/analysis/src/SignatureHelp.ml @@ -33,9 +33,9 @@ let docsForLabel typeExpr ~file ~package ~supportsMarkdownLinks = in typeDefinitions |> String.concat "\n" -let findFunctionType ~currentFile ~debug ~path ~pos = +let findFunctionType ~debug ~source ~kindFile ~pos ~full = (* Start by looking at the typed info at the loc of the fn *) - match Cmt.loadFullCmtFromPath ~path with + match full with | None -> None | Some full -> ( let {file; package} = full in @@ -72,16 +72,15 @@ let findFunctionType ~currentFile ~debug ~path ~pos = | None -> ( (* If nothing was found there, try using the unsaved completion engine *) let completables = - let textOpt = Files.readFile currentFile in - match textOpt with - | None | Some "" -> None - | Some text -> ( + match source with + | "" -> None + | source -> ( (* Leverage the completion functionality to pull out the type of the identifier doing the function application. This lets us leverage all of the smart work done in completions to find the correct type in many cases even for files not saved yet. *) match - CompletionFrontEnd.completionWithParser ~debug ~path ~posCursor:pos - ~currentFile ~text + CompletionFrontEnd.completionWithParser ~debug ~source ~kindFile + ~posCursor:pos with | None -> None | Some (completable, scope) -> @@ -238,11 +237,11 @@ let findConstructorArgs ~full ~env ~constructorName loc = | _ -> None) | _ -> None -let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads = - let textOpt = Files.readFile currentFile in - match textOpt with - | None | Some "" -> None - | Some text -> ( +let signatureHelp ~debug ~source ~kindFile ~pos ~allowForConstructorPayloads + ~full = + match source with + | "" -> None + | text -> ( match Pos.positionToOffset text pos with | None -> None | Some offset -> ( @@ -416,16 +415,17 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads = in let iterator = {Ast_iterator.default_iterator with expr; pat} in 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 = structure} = parser ~filename:currentFile in + let {Res_driver.parsetree = structure} = parser ~source in iterator.structure iterator structure |> ignore; (* Handle function application, if found *) match !result with | Some (_, `FunctionCall (argAtCursor, exp, _extractedArgs)) -> ( (* Not looking for the cursor position after this, but rather the target function expression's loc. *) let pos = exp.pexp_loc |> Loc.end_ in - match findFunctionType ~currentFile ~debug ~path ~pos with + match findFunctionType ~source ~kindFile ~debug ~pos ~full with | Some (args, docstring, type_expr, package, _env, file) -> if debug then Printf.printf "argAtCursor: %s\n" @@ -525,7 +525,7 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads = -> ( if Debug.verbose () then Printf.printf "[signature_help] Found constructor!\n"; - match Cmt.loadFullCmtFromPath ~path with + match full with | None -> if Debug.verbose () then Printf.printf "[signature_help] Could not load cmt\n"; diff --git a/analysis/src/Xform.ml b/analysis/src/Xform.ml index ddf783c5590..8d66d8c757d 100644 --- a/analysis/src/Xform.ml +++ b/analysis/src/Xform.ml @@ -2,10 +2,10 @@ let isBracedExpr = Res_parsetree_viewer.is_braced_expr -let extractTypeFromExpr expr ~debug ~path ~currentFile ~full ~pos = +let extractTypeFromExpr expr ~debug ~source ~kindFile ~full ~pos = match expr.Parsetree.pexp_loc - |> CompletionFrontEnd.findTypeOfExpressionAtLoc ~debug ~path ~currentFile + |> CompletionFrontEnd.findTypeOfExpressionAtLoc ~debug ~source ~kindFile ~posCursor:(Pos.ofLexing expr.Parsetree.pexp_loc.loc_start) with | Some (completable, scope) -> ( @@ -377,7 +377,7 @@ module ExpandCatchAllForVariants = struct in {Ast_iterator.default_iterator with expr} - let xform ~path ~pos ~full ~structure ~currentFile ~codeActions ~debug = + let xform ~source ~kindFile ~path ~pos ~full ~structure ~codeActions ~debug = let result = ref None in let iterator = mkIterator ~pos ~result in iterator.structure iterator structure; @@ -411,7 +411,7 @@ module ExpandCatchAllForVariants = struct let currentConstructorNames = getCurrentConstructorNames cases in match switchExpr - |> extractTypeFromExpr ~debug ~path ~currentFile ~full + |> extractTypeFromExpr ~debug ~source ~kindFile ~full ~pos:(Pos.ofLexing switchExpr.pexp_loc.loc_end) with | Some (Tvariant {constructors}) -> @@ -580,8 +580,8 @@ module ExhaustiveSwitch = struct in {Ast_iterator.default_iterator with expr} - let xform ~printExpr ~path ~currentFile ~pos ~full ~structure ~codeActions - ~debug = + let xform ~printExpr ~path ~source ~kindFile ~pos ~full ~structure + ~codeActions ~debug = (* TODO: Adapt to '(' as leading/trailing character (skip one col, it's not included in the AST) *) let result = ref None in let foundSelection = ref (None, None) in @@ -605,7 +605,7 @@ module ExhaustiveSwitch = struct | Some (Selection {expr}) -> ( match expr - |> extractTypeFromExpr ~debug ~path ~currentFile ~full + |> extractTypeFromExpr ~debug ~source ~kindFile ~full ~pos:(Pos.ofLexing expr.pexp_loc.loc_start) with | None -> () @@ -631,7 +631,7 @@ module ExhaustiveSwitch = struct | Some (Switch {switchExpr; completionExpr; pos}) -> ( match completionExpr - |> extractTypeFromExpr ~debug ~path ~currentFile ~full ~pos + |> extractTypeFromExpr ~debug ~source ~kindFile ~full ~pos with | None -> () | Some extractedType -> ( @@ -840,9 +840,10 @@ module AddDocTemplate = struct end end -let parseImplementation ~filename = +let parseImplementation ~source = let {Res_driver.parsetree = structure; comments} = - Res_driver.parsing_engine.parse_implementation ~for_printer:false ~filename + Res_driver.parsing_engine.parse_implementation_from_source + ~for_printer:false ~source in let filterComments ~loc comments = (* Relevant comments in the range of the expression *) @@ -873,9 +874,10 @@ let parseImplementation ~filename = in (structure, printExpr, printStructureItem, printStandaloneStructure) -let parseInterface ~filename = +let parseInterface ~source = let {Res_driver.parsetree = structure; comments} = - Res_driver.parsing_engine.parse_interface ~for_printer:false ~filename + Res_driver.parsing_engine.parse_interface_from_source ~for_printer:false + ~source in let filterComments ~loc comments = (* Relevant comments in the range of the expression *) @@ -894,13 +896,13 @@ let parseInterface ~filename = in (structure, printSignatureItem) -let extractCodeActions ~path ~startPos ~endPos ~currentFile ~debug = +let extractCodeActions ~path ~startPos ~endPos ~source ~kindFile ~debug = let pos = startPos in let codeActions = ref [] in - match Files.classifySourceFile currentFile with - | Res -> + match kindFile with + | Files.Res -> let structure, printExpr, printStructureItem, printStandaloneStructure = - parseImplementation ~filename:currentFile + parseImplementation ~source in IfThenElse.xform ~pos ~codeActions ~printExpr ~path structure; ModuleToFile.xform ~pos ~codeActions ~path ~printStandaloneStructure @@ -914,19 +916,19 @@ let extractCodeActions ~path ~startPos ~endPos ~currentFile ~debug = match Cmt.loadFullCmtFromPath ~path with | Some full -> AddTypeAnnotation.xform ~path ~pos ~full ~structure ~codeActions ~debug; - ExpandCatchAllForVariants.xform ~path ~pos ~full ~structure ~codeActions - ~currentFile ~debug; - ExhaustiveSwitch.xform ~printExpr ~path + ExpandCatchAllForVariants.xform ~path ~source ~kindFile ~pos ~full + ~structure ~codeActions ~debug; + ExhaustiveSwitch.xform ~printExpr ~path ~source ~kindFile ~pos: (if startPos = endPos then Single startPos else Range (startPos, endPos)) - ~full ~structure ~codeActions ~debug ~currentFile + ~full ~structure ~codeActions ~debug | None -> () in !codeActions | Resi -> - let signature, printSignatureItem = parseInterface ~filename:currentFile in + let signature, printSignatureItem = parseInterface ~source in AddDocTemplate.Interface.xform ~pos ~codeActions ~path ~signature ~printSignatureItem; !codeActions diff --git a/compiler/syntax/src/res_ast_debugger.ml b/compiler/syntax/src/res_ast_debugger.ml index cabd950235c..8f8ebdb0bb7 100644 --- a/compiler/syntax/src/res_ast_debugger.ml +++ b/compiler/syntax/src/res_ast_debugger.ml @@ -7,12 +7,15 @@ let print_engine = print_implementation = (fun ~width:_ ~filename:_ ~comments:_ structure -> Printast.implementation Format.std_formatter structure); - parse_implementation_from_source = + print_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); + print_interface_from_source = + (fun ~width:_ ~source:_ ~comments:_ signature -> + Printast.interface Format.std_formatter signature); } module Sexp : sig @@ -965,12 +968,15 @@ module SexpAst = struct print_implementation = (fun ~width:_ ~filename:_ ~comments:_ parsetree -> parsetree |> structure |> Sexp.to_string |> print_string); - parse_implementation_from_source = + print_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); + print_interface_from_source = + (fun ~width:_ ~source:_ ~comments:_ parsetree -> + parsetree |> signature |> Sexp.to_string |> print_string); } end @@ -983,14 +989,19 @@ 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 = + Res_driver.print_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 = + Res_driver.print_interface = (fun ~width:_ ~filename:_ ~comments s -> let cmt_tbl = CommentTable.make () in CommentTable.walk_signature s cmt_tbl comments; CommentTable.log cmt_tbl); + Res_driver.print_interface_from_source = + (fun ~width:_ ~source:_ ~comments s -> + let cmt_tbl = CommentTable.make () in + CommentTable.walk_signature s cmt_tbl comments; + CommentTable.log cmt_tbl); } diff --git a/compiler/syntax/src/res_driver.ml b/compiler/syntax/src/res_driver.ml index 5a8d07ab593..eddb55a1f27 100644 --- a/compiler/syntax/src/res_driver.ml +++ b/compiler/syntax/src/res_driver.ml @@ -22,6 +22,10 @@ type 'diagnostics parsing_engine = { for_printer:bool -> filename:string -> (Parsetree.signature, 'diagnostics) parse_result; + parse_interface_from_source: + for_printer:bool -> + source:string -> + (Parsetree.signature, 'diagnostics) parse_result; string_of_diagnostics: source:string -> filename:string -> 'diagnostics -> unit; } @@ -33,7 +37,7 @@ type print_engine = { comments:Res_comment.t list -> Parsetree.structure -> unit; - parse_implementation_from_source: + print_implementation_from_source: width:int -> source:string -> comments:Res_comment.t list -> @@ -45,6 +49,12 @@ type print_engine = { comments:Res_comment.t list -> Parsetree.signature -> unit; + print_interface_from_source: + width:int -> + source:string -> + comments:Res_comment.t list -> + Parsetree.signature -> + unit; } let setup ~filename ~for_printer () = @@ -111,6 +121,25 @@ let parsing_engine = invalid; comments = List.rev engine.comments; }); + parse_interface_from_source = + (fun ~for_printer ~source -> + let engine = + setup_from_source ~source ~display_filename:"" ~for_printer () + in + let signature = Res_core.parse_specification 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 = signature; + diagnostics; + invalid; + comments = List.rev engine.comments; + }); string_of_diagnostics = (fun ~source ~filename:_ diagnostics -> Res_diagnostics.print_report diagnostics source); @@ -156,13 +185,16 @@ let print_engine = (fun ~width ~filename:_ ~comments structure -> print_string (Res_printer.print_implementation ~width structure ~comments)); - parse_implementation_from_source = + print_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)); + print_interface_from_source = + (fun ~width ~source:_ ~comments signature -> + print_string (Res_printer.print_interface ~width signature ~comments)); } let parse_implementation ?(ignore_parse_errors = false) sourcefile = diff --git a/compiler/syntax/src/res_driver.mli b/compiler/syntax/src/res_driver.mli index 8546224b395..4d6feb13de6 100644 --- a/compiler/syntax/src/res_driver.mli +++ b/compiler/syntax/src/res_driver.mli @@ -20,6 +20,10 @@ type 'diagnostics parsing_engine = { for_printer:bool -> filename:string -> (Parsetree.signature, 'diagnostics) parse_result; + parse_interface_from_source: + for_printer:bool -> + source:string -> + (Parsetree.signature, 'diagnostics) parse_result; string_of_diagnostics: source:string -> filename:string -> 'diagnostics -> unit; } @@ -45,7 +49,7 @@ type print_engine = { comments:Res_comment.t list -> Parsetree.structure -> unit; - parse_implementation_from_source: + print_implementation_from_source: width:int -> source:string -> comments:Res_comment.t list -> @@ -57,6 +61,12 @@ type print_engine = { comments:Res_comment.t list -> Parsetree.signature -> unit; + print_interface_from_source: + width:int -> + source:string -> + comments:Res_comment.t list -> + Parsetree.signature -> + unit; } val parsing_engine : Res_diagnostics.t list parsing_engine diff --git a/compiler/syntax/src/res_driver_binary.ml b/compiler/syntax/src/res_driver_binary.ml index 59ce51c7165..b6c9318d5cc 100644 --- a/compiler/syntax/src/res_driver_binary.ml +++ b/compiler/syntax/src/res_driver_binary.ml @@ -6,7 +6,7 @@ let print_engine = output_string stdout Config.ast_impl_magic_number; output_value stdout filename; output_value stdout structure); - parse_implementation_from_source = + print_implementation_from_source = (fun ~width:_ ~source:_ ~comments:_ structure -> output_string stdout Config.ast_impl_magic_number; output_value stdout "source"; @@ -16,4 +16,9 @@ let print_engine = output_string stdout Config.ast_intf_magic_number; output_value stdout filename; output_value stdout signature); + print_interface_from_source = + (fun ~width:_ ~source:_ ~comments:_ signature -> + output_string stdout Config.ast_intf_magic_number; + output_value stdout "source"; + output_value stdout signature); } diff --git a/compiler/syntax/src/res_driver_ml_printer.ml b/compiler/syntax/src/res_driver_ml_printer.ml index dd94a9e9611..232e328bf15 100644 --- a/compiler/syntax/src/res_driver_ml_printer.ml +++ b/compiler/syntax/src/res_driver_ml_printer.ml @@ -4,10 +4,13 @@ let print_engine = print_implementation = (fun ~width:_ ~filename:_ ~comments:_ structure -> Pprintast.structure Format.std_formatter structure); - parse_implementation_from_source = + print_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); + print_interface_from_source = + (fun ~width:_ ~source:_ ~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 387beb15a8f..23208ccdfad 100644 --- a/compiler/syntax/src/res_token_debugger.ml +++ b/compiler/syntax/src/res_token_debugger.ml @@ -142,8 +142,10 @@ 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 = + Res_driver.print_implementation_from_source = + (fun ~width:_ ~source ~comments:_ _ -> dump_tokens source); + Res_driver.print_interface = (fun ~width:_ ~filename ~comments:_ _ -> dump_tokens filename); + Res_driver.print_interface_from_source = + (fun ~width:_ ~source ~comments:_ _ -> dump_tokens source); } From 743126f8c870e24fd58fa35f73e66edf0ab94737 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Fri, 15 May 2026 23:54:23 -0300 Subject: [PATCH 08/37] Delegate hover logic to `Analysis.Commands.hover` --- lsp/src/hover.ml | 122 +++---------------------------------------- tests/lsp_tests/dune | 15 +++--- 2 files changed, 16 insertions(+), 121 deletions(-) diff --git a/lsp/src/hover.ml b/lsp/src/hover.ml index 4710ec70678..b75d71e9197 100644 --- a/lsp/src/hover.ml +++ b/lsp/src/hover.ml @@ -1,85 +1,5 @@ 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) (server : State.t Server.t) = let path = DocumentUri.to_path uri in @@ -88,41 +8,15 @@ let create ~(position : Position.t) ~(uri : DocumentUri.t) (* NOTE: Should be a config *) let supportsMarkdownLinks = true in - let currentFile = - (Document_store.get_document ~uri server.state.store).text - in - let debug = false in - let result = - 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) + let open Analysis in + let source = (Document_store.get_document ~uri server.state.store).text in + let debug = false in + + let kindFile = Files.classifySourceFile path in + let full = Cmt.loadFullCmtFromPath ~path in + + Commands.hover ~source ~kindFile ~pos ~debug ~supportsMarkdownLinks ~full in match result with diff --git a/tests/lsp_tests/dune b/tests/lsp_tests/dune index ecbed12aff6..fd9baef10d0 100644 --- a/tests/lsp_tests/dune +++ b/tests/lsp_tests/dune @@ -1,9 +1,10 @@ (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"))) + (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)) +(dirs + (:standard \ ignored_dir basic-workspace)) From 0e522be0a2361f400da74ae67a3c28f8c2e29d07 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sat, 16 May 2026 00:53:26 -0300 Subject: [PATCH 09/37] Rename `tokenModifiersString` to `tokenModifiers` with correct type --- analysis/src/SemanticTokens.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/analysis/src/SemanticTokens.ml b/analysis/src/SemanticTokens.ml index 94895188a29..86feab8ef8d 100644 --- a/analysis/src/SemanticTokens.ml +++ b/analysis/src/SemanticTokens.ml @@ -49,7 +49,7 @@ module Token = struct | Property -> "Property" | JsxLowercase -> "JsxLowercase" - let tokenModifiersString = "0" (* None at the moment *) + let tokenModifiers = 0 (* None at the moment *) type token = int * int * int * tokenType @@ -70,7 +70,8 @@ module Token = struct e.lastLine <- line; e.lastChar <- char; if deltaLine >= 0 && deltaChar >= 0 && length >= 0 then - Some [|deltaLine; deltaChar; length; tokenTypeToInt type_; 0|] + Some + [|deltaLine; deltaChar; length; tokenTypeToInt type_; tokenModifiers|] else None let emit e = From 9df90792f76bf24fb6ea257a55d9a6bb5cafc45b Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Fri, 22 May 2026 10:17:11 -0300 Subject: [PATCH 10/37] Update dune-project --- dune-project | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/dune-project b/dune-project index 404204f7f95..daeae82e536 100644 --- a/dune-project +++ b/dune-project @@ -69,3 +69,18 @@ (= 1.8.0)) analysis (odoc :with-doc))) + +(package + (name rescript-language-server) + (synopsis "ReScript LSP") + (depends + (ocaml + (>= 4.10)) + (lsp + (>= 1.22.0)) + (eio + (>= 1.3)) + (eio_main + (>= 1.3)) + analysis + dune)) From 29cd3d7945900c261c2f8a0d270cb60fc6c57b59 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sun, 31 May 2026 17:39:28 -0300 Subject: [PATCH 11/37] Refactor LSP test infrastructure - Rename Helper module to Client - Move expected output files into workspace directories - Improve request log format to show file path:line:col - Simplify hover.ml by removing intermediate result binding - Disable in-source compilation for basic-workspace --- lsp/src/hover.ml | 26 +- .../Hover.res.expected | 98 +++--- tests/lsp_tests/basic-workspace/Hover.res.js | 288 ------------------ tests/lsp_tests/basic-workspace/rescript.json | 2 +- tests/lsp_tests/test.ml | 149 +++++---- 5 files changed, 144 insertions(+), 419 deletions(-) rename tests/lsp_tests/{expected => basic-workspace}/Hover.res.expected (72%) delete mode 100644 tests/lsp_tests/basic-workspace/Hover.res.js diff --git a/lsp/src/hover.ml b/lsp/src/hover.ml index b75d71e9197..32eb4670fd7 100644 --- a/lsp/src/hover.ml +++ b/lsp/src/hover.ml @@ -7,24 +7,10 @@ let create ~(position : Position.t) ~(uri : DocumentUri.t) (* NOTE: Should be a config *) let supportsMarkdownLinks = true in + let debug = false in + let open Analysis in + let source = (Document_store.get_document ~uri server.state.store).text in + let kindFile = Files.classifySourceFile path in + let full = Cmt.loadFullCmtFromPath ~path in - let result = - let open Analysis in - let source = (Document_store.get_document ~uri server.state.store).text in - let debug = false in - - let kindFile = Files.classifySourceFile path in - let full = Cmt.loadFullCmtFromPath ~path in - - Commands.hover ~source ~kindFile ~pos ~debug ~supportsMarkdownLinks ~full - in - - match result with - | None -> None - | Some value -> - Some - (Hover.create - ~contents: - (`MarkupContent - (MarkupContent.create ~kind:MarkupKind.Markdown ~value)) - ()) + Commands.hover ~source ~kindFile ~pos ~debug ~supportsMarkdownLinks ~full diff --git a/tests/lsp_tests/expected/Hover.res.expected b/tests/lsp_tests/basic-workspace/Hover.res.expected similarity index 72% rename from tests/lsp_tests/expected/Hover.res.expected rename to tests/lsp_tests/basic-workspace/Hover.res.expected index c71369a28a4..e5a6f734da4 100644 --- a/tests/lsp_tests/expected/Hover.res.expected +++ b/tests/lsp_tests/basic-workspace/Hover.res.expected @@ -1,8 +1,8 @@ -Request textDocument/hover Line: 1 Character: 4 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:1:5 Response { "contents": { "kind": "markdown", "value": "```rescript\nint\n```" } } -Request textDocument/hover Line: 4 Character: 5 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:4:6 Response { "contents": { @@ -11,7 +11,7 @@ Response } } -Request textDocument/hover Line: 7 Character: 7 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:7:8 Response { "contents": { @@ -20,7 +20,7 @@ Response } } -Request textDocument/hover Line: 20 Character: 11 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:20:12 Response { "contents": { @@ -29,7 +29,7 @@ Response } } -Request textDocument/hover Line: 23 Character: 11 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:23:12 Response { "contents": { @@ -38,11 +38,11 @@ Response } } -Request textDocument/hover Line: 27 Character: 6 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:27:7 Response { "contents": { "kind": "markdown", "value": "```rescript\nint\n```" } } -Request textDocument/hover Line: 34 Character: 4 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:34:5 Response { "contents": { @@ -51,19 +51,19 @@ Response } } -Request textDocument/hover Line: 38 Character: 13 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:38:14 Response { "contents": { "kind": "markdown", "value": "```rescript\nstring\n```" } } -Request textDocument/hover Line: 43 Character: 15 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:43:16 Response { "contents": { "kind": "markdown", "value": "```rescript\nstring\n```" } } -Request textDocument/hover Line: 47 Character: 10 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:47:11 Response { "contents": { "kind": "markdown", "value": "```rescript\nint\n```" } } -Request textDocument/hover Line: 50 Character: 13 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:50:14 Response { "contents": { @@ -72,7 +72,7 @@ Response } } -Request textDocument/hover Line: 55 Character: 7 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:55:8 Response { "contents": { @@ -81,7 +81,9 @@ Response } } -Command `def` not implemented!Request textDocument/hover Line: 64 Character: 9 +Command `def` not implemented! tests/lsp_tests/basic-workspace/Hover.res:61:15 + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:64:10 Response { "contents": { @@ -90,7 +92,7 @@ Response } } -Request textDocument/hover Line: 75 Character: 7 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:75:8 Response { "contents": { @@ -99,7 +101,7 @@ Response } } -Request textDocument/hover Line: 78 Character: 7 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:78:8 Response { "contents": { @@ -108,23 +110,23 @@ Response } } -Request textDocument/hover Line: 92 Character: 10 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:92:11 Response null -Request textDocument/hover Line: 99 Character: 10 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:99:11 Response null -Request textDocument/hover Line: 104 Character: 25 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:104:26 Response { "contents": { "kind": "markdown", "value": "```rescript\nfloat\n```" } } -Request textDocument/hover Line: 107 Character: 21 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:107:22 Response { "contents": { "kind": "markdown", "value": "```rescript\nint\n```" } } -Request textDocument/hover Line: 117 Character: 16 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:117:17 Response { "contents": { @@ -133,7 +135,7 @@ Response } } -Request textDocument/hover Line: 120 Character: 25 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:120:26 Response { "contents": { @@ -142,7 +144,7 @@ Response } } -Request textDocument/hover Line: 123 Character: 3 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:123:4 Response { "contents": { @@ -151,7 +153,7 @@ Response } } -Request textDocument/hover Line: 132 Character: 4 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:132:5 Response { "contents": { @@ -160,7 +162,7 @@ Response } } -Request textDocument/hover Line: 135 Character: 4 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:135:5 Response { "contents": { @@ -169,7 +171,7 @@ Response } } -Request textDocument/hover Line: 138 Character: 5 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:138:6 Response { "contents": { @@ -178,7 +180,7 @@ Response } } -Request textDocument/hover Line: 145 Character: 9 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:145:10 Response { "contents": { @@ -187,7 +189,7 @@ Response } } -Request textDocument/hover Line: 149 Character: 6 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:149:7 Response { "contents": { @@ -196,7 +198,7 @@ Response } } -Request textDocument/hover Line: 166 Character: 23 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:166:24 Response { "contents": { @@ -205,7 +207,7 @@ Response } } -Request textDocument/hover Line: 168 Character: 22 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:168:23 Response { "contents": { @@ -214,7 +216,15 @@ Response } } -Command `com` not implemented!Command `com` not implemented!Command `com` not implemented!Command `com` not implemented!Request textDocument/hover Line: 198 Character: 4 +Command `com` not implemented! tests/lsp_tests/basic-workspace/Hover.res:171:17 + +Command `com` not implemented! tests/lsp_tests/basic-workspace/Hover.res:174:17 + +Command `com` not implemented! tests/lsp_tests/basic-workspace/Hover.res:183:17 + +Command `com` not implemented! tests/lsp_tests/basic-workspace/Hover.res:186:17 + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:198:5 Response { "contents": { @@ -223,7 +233,7 @@ Response } } -Request textDocument/hover Line: 203 Character: 16 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:203:17 Response { "contents": { @@ -232,11 +242,11 @@ Response } } -Request textDocument/hover Line: 211 Character: 13 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:211:14 Response null -Request textDocument/hover Line: 230 Character: 20 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:230:21 Response { "contents": { @@ -245,7 +255,7 @@ Response } } -Request textDocument/hover Line: 233 Character: 17 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:233:18 Response { "contents": { @@ -254,11 +264,11 @@ Response } } -Request textDocument/hover Line: 245 Character: 6 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:245:7 Response null -Request textDocument/hover Line: 248 Character: 19 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:248:20 Response { "contents": { @@ -267,7 +277,7 @@ Response } } -Request textDocument/hover Line: 257 Character: 20 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:257:21 Response { "contents": { @@ -276,7 +286,7 @@ Response } } -Request textDocument/hover Line: 262 Character: 22 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:262:23 Response { "contents": { @@ -285,7 +295,7 @@ Response } } -Request textDocument/hover Line: 265 Character: 23 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:265:24 Response { "contents": { @@ -294,7 +304,7 @@ Response } } -Request textDocument/hover Line: 272 Character: 42 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:272:43 Response { "contents": { @@ -303,15 +313,15 @@ Response } } -Request textDocument/hover Line: 276 Character: 23 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:276:24 Response null -Request textDocument/hover Line: 279 Character: 33 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:279:34 Response null -Request textDocument/hover Line: 282 Character: 8 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:282:9 Response { "contents": { @@ -320,7 +330,7 @@ Response } } -Request textDocument/hover Line: 285 Character: 6 +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:285:7 Response { "contents": { diff --git a/tests/lsp_tests/basic-workspace/Hover.res.js b/tests/lsp_tests/basic-workspace/Hover.res.js deleted file mode 100644 index 84e61d64681..00000000000 --- a/tests/lsp_tests/basic-workspace/Hover.res.js +++ /dev/null @@ -1,288 +0,0 @@ -// 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/rescript.json b/tests/lsp_tests/basic-workspace/rescript.json index 76742555703..0f6ec0f0d92 100644 --- a/tests/lsp_tests/basic-workspace/rescript.json +++ b/tests/lsp_tests/basic-workspace/rescript.json @@ -5,7 +5,7 @@ }, "package-specs": { "module": "esmodule", - "in-source": true + "in-source": false }, "suffix": ".res.js", "dependencies": ["@rescript/react"], diff --git a/tests/lsp_tests/test.ml b/tests/lsp_tests/test.ml index 378671874ee..62319d87d7e 100644 --- a/tests/lsp_tests/test.ml +++ b/tests/lsp_tests/test.ml @@ -1,9 +1,10 @@ -module Helper = struct +let ( // ) = Filename.concat +let executable = "_build" // "default" // "lsp" // "bin" // "main.exe" + +module Client = 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; @@ -48,8 +49,7 @@ module Helper = struct 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 [] + Eio.Process.spawn ~sw mgr ~stdin:stdin_r ~stdout:stdout_w ~executable [] in Eio.Resource.close stdin_r; Eio.Resource.close stdout_w; @@ -118,24 +118,26 @@ open Lsp open Types type caret_comment = { - path: string; + path: string; (* absolute path *) line: int; (* line of the comment *) col: int; (* column of the ^ character *) command: string; (* e.g. "hov" *) - text: string; + text: string; (* file content *) } -module StringMap = Map.Make (String) +module String_map = Map.Make (String) -let find_caret_comments ~fs ~dir = +let find_caret_comments ~fs ~workspace_dir = let results = ref [] in (* Read all .res files in directory *) Eio.Path.with_open_dir - Eio.Path.(fs / dir) + Eio.Path.(fs / workspace_dir) (fun dir_handle -> Eio.Path.read_dir dir_handle - |> List.filter (String.ends_with ~suffix:".res") + |> List.filter (fun file -> + String.ends_with ~suffix:".res" file + || String.ends_with ~suffix:".resi" file) |> List.iter (fun filename -> let path = Eio.Path.(dir_handle / filename) in let content = Eio.Path.load path in @@ -164,8 +166,7 @@ let find_caret_comments ~fs ~dir = in results := { - (* TODO: rewrite this *) - path = Sys.getcwd () ^ "/" ^ dir ^ "/" ^ snd path; + path = workspace_dir // snd path; line = line_idx; col; command; @@ -177,82 +178,98 @@ let find_caret_comments ~fs ~dir = 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 +let open_document ~uri ~text client = + Client.send_notification client + (Client_notification.TextDocumentDidOpen + (DidOpenTextDocumentParams.create + ~textDocument: + (TextDocumentItem.create ~uri ~languageId:"rescript" ~version:0 + ~text))) + +let pretty_source_loc caret_comment = + let relative_path = + let dir_len = String.length (Sys.getcwd () ^ "/") in + String.sub caret_comment.path dir_len + (String.length caret_comment.path - dir_len) 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 + Printf.sprintf "%s:%d:%d" relative_path caret_comment.line + (caret_comment.col + 1) + +let send_request payload client = + let response = Client.request client payload in + Client_request.yojson_of_result payload response + |> Yojson.Safe.pretty_to_string ~std:true + +let print_response method_ response caret_comment = + Printf.sprintf "Request %s %s\nResponse\n%s\n\n" method_ + (pretty_source_loc caret_comment) + response - let comment_to_lsp (caret_comment : caret_comment) = - let uri = DocumentUri.of_path caret_comment.path in - let textDocument = TextDocumentIdentifier.create ~uri in +let run_test_for_comment (caret_comment : caret_comment) client = + 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 + 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; + match caret_comment.command with + | "hov" -> + open_document ~uri ~text client; + let resp = 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 + client + in + print_response "textDocument/hover" resp 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! %s\n\n" other + (pretty_source_loc caret_comment) + +let run_workspace_test ~fs ~workspace_dir client = + let comments = find_caret_comments ~fs ~workspace_dir in let grouped = List.fold_left (fun acc comment -> let others = - Option.value ~default:[] (StringMap.find_opt comment.path acc) + Option.value ~default:[] (String_map.find_opt comment.path acc) in - StringMap.add comment.path (comment :: others) acc) - StringMap.empty comments + String_map.add comment.path (comment :: others) acc) + String_map.empty comments in - StringMap.iter + String_map.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 save_path = workspace_dir // filename in + let content = + List.rev_map (fun c -> run_test_for_comment c client) 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 + Client.with_server ~env @@ fun client -> + let workspace_dir = + Sys.getcwd () // "tests" // "lsp_tests" // "basic-workspace" + in + run_workspace_test ~fs:env#fs ~workspace_dir client; + Client.stop client |> ignore let () = main () From a20da0da86dbe8f65125ed29b27de23026968031 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sun, 31 May 2026 18:06:03 -0300 Subject: [PATCH 12/37] ci: add linux-headers --- .github/workflows/ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 78bad0e36dd..bc0abea21b6 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -106,7 +106,7 @@ jobs: with: # https://github.com/ocaml/setup-ocaml/blob/2f57267f071bc8547dfcb9433ff21d44fffef190/packages/setup-ocaml/src/unix.ts#L48 # plus OPAM wants cmake - packages: bubblewrap darcs g++-multilib gcc-multilib mercurial musl-tools rsync cmake + packages: bubblewrap darcs g++-multilib gcc-multilib mercurial musl-tools rsync cmake linux-headers version: v4 - name: Restore rewatch build cache From 5a57bbc5e4ebfb27224b2834816200a337b35561 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sun, 31 May 2026 18:19:15 -0300 Subject: [PATCH 13/37] ci: add linux-headers-generic --- .github/workflows/ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index bc0abea21b6..c6f0721cf6e 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -106,7 +106,7 @@ jobs: with: # https://github.com/ocaml/setup-ocaml/blob/2f57267f071bc8547dfcb9433ff21d44fffef190/packages/setup-ocaml/src/unix.ts#L48 # plus OPAM wants cmake - packages: bubblewrap darcs g++-multilib gcc-multilib mercurial musl-tools rsync cmake linux-headers + packages: bubblewrap darcs g++-multilib gcc-multilib mercurial musl-tools rsync cmake linux-headers linux-headers-generic version: v4 - name: Restore rewatch build cache From 9442c4b26df4891da21d3adf950c221ba8b2688c Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sun, 31 May 2026 18:57:02 -0300 Subject: [PATCH 14/37] ci: linux-libc-dev --- .github/workflows/ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index c6f0721cf6e..48e20577518 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -106,7 +106,7 @@ jobs: with: # https://github.com/ocaml/setup-ocaml/blob/2f57267f071bc8547dfcb9433ff21d44fffef190/packages/setup-ocaml/src/unix.ts#L48 # plus OPAM wants cmake - packages: bubblewrap darcs g++-multilib gcc-multilib mercurial musl-tools rsync cmake linux-headers linux-headers-generic + packages: bubblewrap darcs g++-multilib gcc-multilib mercurial musl-tools rsync cmake linux-libc-dev version: v4 - name: Restore rewatch build cache From 64dffd8566a3a823d9cfec413668561fcbd11e4f Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sun, 31 May 2026 19:11:19 -0300 Subject: [PATCH 15/37] ci: add build-essential --- .github/workflows/ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 48e20577518..f0bc3327e6a 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -106,7 +106,7 @@ jobs: with: # https://github.com/ocaml/setup-ocaml/blob/2f57267f071bc8547dfcb9433ff21d44fffef190/packages/setup-ocaml/src/unix.ts#L48 # plus OPAM wants cmake - packages: bubblewrap darcs g++-multilib gcc-multilib mercurial musl-tools rsync cmake linux-libc-dev + packages: bubblewrap darcs g++-multilib gcc-multilib mercurial musl-tools rsync cmake build-essential version: v4 - name: Restore rewatch build cache From e0f6296dfc0f972f64141e08fe9edd2c6a5b3631 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sun, 31 May 2026 20:16:21 -0300 Subject: [PATCH 16/37] ci: add build-essential and linux-libc-dev --- .github/workflows/ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index f0bc3327e6a..3e70177a0c7 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -106,7 +106,7 @@ jobs: with: # https://github.com/ocaml/setup-ocaml/blob/2f57267f071bc8547dfcb9433ff21d44fffef190/packages/setup-ocaml/src/unix.ts#L48 # plus OPAM wants cmake - packages: bubblewrap darcs g++-multilib gcc-multilib mercurial musl-tools rsync cmake build-essential + packages: bubblewrap darcs g++-multilib gcc-multilib mercurial musl-tools rsync cmake build-essential linux-libc-dev version: v4 - name: Restore rewatch build cache From 8cebaf2c67fd917cb27fb39f7e55357e64b95ebb Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sun, 31 May 2026 20:30:34 -0300 Subject: [PATCH 17/37] ci: update cache version to v5 --- .github/workflows/ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 3e70177a0c7..8d3d7c824ac 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -107,7 +107,7 @@ jobs: # https://github.com/ocaml/setup-ocaml/blob/2f57267f071bc8547dfcb9433ff21d44fffef190/packages/setup-ocaml/src/unix.ts#L48 # plus OPAM wants cmake packages: bubblewrap darcs g++-multilib gcc-multilib mercurial musl-tools rsync cmake build-essential linux-libc-dev - version: v4 + version: v5 - name: Restore rewatch build cache id: rewatch-build-cache From 85138b1098ef2e0870e98f8591a00c9a62bbbf65 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Mon, 1 Jun 2026 20:26:16 -0300 Subject: [PATCH 18/37] ci: make Linux headers visible to musl-gcc --- .github/workflows/ci.yml | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 8d3d7c824ac..2977269a77f 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -106,7 +106,7 @@ jobs: with: # https://github.com/ocaml/setup-ocaml/blob/2f57267f071bc8547dfcb9433ff21d44fffef190/packages/setup-ocaml/src/unix.ts#L48 # plus OPAM wants cmake - packages: bubblewrap darcs g++-multilib gcc-multilib mercurial musl-tools rsync cmake build-essential linux-libc-dev + packages: bubblewrap darcs g++-multilib gcc-multilib mercurial musl-tools rsync cmake version: v5 - name: Restore rewatch build cache @@ -176,6 +176,23 @@ jobs: C:\.opam key: ${{ env.opam_cache_key }} + # The static OCaml switch uses musl-gcc. linux-libc-dev installs Linux + # headers under /usr/include, but musl-gcc searches the musl include dir. + # Link the Linux headers into musl's include path so packages with C stubs + # such as uring can include headers. + - name: Make Linux headers visible to musl-gcc + if: runner.os == 'Linux' + run: | + sudo mkdir -p /usr/include/x86_64-linux-musl + + sudo rm -rf /usr/include/x86_64-linux-musl/linux + sudo rm -rf /usr/include/x86_64-linux-musl/asm + sudo rm -rf /usr/include/x86_64-linux-musl/asm-generic + + sudo ln -s /usr/include/linux /usr/include/x86_64-linux-musl/linux + sudo ln -s /usr/include/x86_64-linux-gnu/asm /usr/include/x86_64-linux-musl/asm + sudo ln -s /usr/include/asm-generic /usr/include/x86_64-linux-musl/asm-generic + - name: Use OCaml ${{matrix.ocaml_compiler}} uses: ocaml/setup-ocaml@v3.6.0 if: steps.cache-opam-env.outputs.cache-hit != 'true' From 66b69febf346df636ecabc73342e9a10549c6de5 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Mon, 1 Jun 2026 20:56:34 -0300 Subject: [PATCH 19/37] ci: support arm and disable test for build for ocaml 5.0 --- .github/workflows/ci.yml | 58 +++++++++++++++++++++++++++++++--------- 1 file changed, 46 insertions(+), 12 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 2977269a77f..4c09b1d6b5e 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -66,12 +66,13 @@ jobs: exe-suffix: ".exe" dune-profile: release + # Disable for now. eio and eio_main require ocaml >= 5.2.0 # Verify that the compiler still builds with the oldest OCaml version we support. - - os: ubuntu-24.04 - ocaml_compiler: ocaml-variants.5.0.0+options,ocaml-option-static - node-target: linux-x64 - rust-target: x86_64-unknown-linux-musl - dune-profile: static + # - os: ubuntu-24.04 + # ocaml_compiler: ocaml-variants.5.0.0+options,ocaml-option-static + # node-target: linux-x64 + # rust-target: x86_64-unknown-linux-musl + # dune-profile: static runs-on: ${{matrix.os}} @@ -183,15 +184,48 @@ jobs: - name: Make Linux headers visible to musl-gcc if: runner.os == 'Linux' run: | - sudo mkdir -p /usr/include/x86_64-linux-musl + set -eux + + # Get the GNU multiarch triplet for the current machine. + # Examples: + # x86_64-linux-gnu + # aarch64-linux-gnu + GNU_MULTIARCH="$(gcc -print-multiarch)" + + # Convert the GNU triplet into the musl include directory name. + # Examples: + # x86_64-linux-gnu -> x86_64-linux-musl + # aarch64-linux-gnu -> aarch64-linux-musl + MUSL_MULTIARCH="${GNU_MULTIARCH%-gnu}-musl" + + # musl-gcc searches this include directory. + MUSL_INCLUDE="/usr/include/${MUSL_MULTIARCH}" + + # Linux arch-specific asm headers are installed here by linux-libc-dev. + GNU_ASM="/usr/include/${GNU_MULTIARCH}/asm" + + # Ensure the musl include directory exists. + sudo mkdir -p "$MUSL_INCLUDE" + + # Remove old paths first. + # This avoids silently keeping broken/stale symlinks from previous runs. + sudo rm -rf "$MUSL_INCLUDE/linux" + sudo rm -rf "$MUSL_INCLUDE/asm" + sudo rm -rf "$MUSL_INCLUDE/asm-generic" + + # Expose Linux UAPI headers to musl-gcc. + # This fixes packages that include headers like . + sudo ln -s /usr/include/linux "$MUSL_INCLUDE/linux" + + # Expose architecture-specific asm headers to musl-gcc. + sudo ln -s "$GNU_ASM" "$MUSL_INCLUDE/asm" - sudo rm -rf /usr/include/x86_64-linux-musl/linux - sudo rm -rf /usr/include/x86_64-linux-musl/asm - sudo rm -rf /usr/include/x86_64-linux-musl/asm-generic + # Expose generic asm headers used by many Linux headers. + sudo ln -s /usr/include/asm-generic "$MUSL_INCLUDE/asm-generic" - sudo ln -s /usr/include/linux /usr/include/x86_64-linux-musl/linux - sudo ln -s /usr/include/x86_64-linux-gnu/asm /usr/include/x86_64-linux-musl/asm - sudo ln -s /usr/include/asm-generic /usr/include/x86_64-linux-musl/asm-generic + # Smoke test: fail early if musl-gcc still cannot find Linux headers. + echo '#include ' > /tmp/test.c + musl-gcc -c /tmp/test.c -o /tmp/test.o - name: Use OCaml ${{matrix.ocaml_compiler}} uses: ocaml/setup-ocaml@v3.6.0 From c50f613253f0448f5361711fc7d3394265bd1c3f Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Mon, 1 Jun 2026 22:13:56 -0300 Subject: [PATCH 20/37] makefile: add test-lsp --- Makefile | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 9b096b7c00e..c9508cb8d06 100644 --- a/Makefile +++ b/Makefile @@ -176,7 +176,20 @@ test-gentype: lib test-rewatch: lib ./rewatch/tests/suite.sh $(RESCRIPT_EXE) -test-all: test test-gentype test-analysis test-tools test-rewatch +test-lsp: lib + @for dir in tests/lsp_tests/*-workspace/; do \ + [ -d "$$dir" ] || continue; \ + echo "Building $${dir%/}..."; \ + ( cd "$$dir" && yarn clean && yarn build ); \ + done + @dune exec -- lsp-tests + @if [ -n "$$(git ls-files --modified tests/lsp_tests/**/*.expected)" ]; then \ + echo "The lsp_tests snapshot doesn't match. Double check that the output is correct, run 'make test-lsp' and stage the diff"; \ + git --no-pager diff tests/lsp_tests/**/*.expected; \ + exit 1; \ + fi \ + +test-all: test test-gentype test-analysis test-tools test-rewatch test-lsp # Playground From 890fd16953e9c9c1e300cacaa8eb85a362314382 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Fri, 5 Jun 2026 17:35:59 -0300 Subject: [PATCH 21/37] Add LSP compiler diagnostics and file watching Parse ReScript compiler logs into LSP diagnostics and keep diagnostic state in the language server so stale entries can be cleared when logs change. Read build roots from .sourcedirs.json to support monorepos and refresh diagnostics across all compiler logs instead of only the changed watch path. Register dynamic workspace/didChangeWatchedFiles watchers after the client sends initialized, and add server-side request/response tracking so client responses to server requests no longer crash the input loop. Tighten document store errors, thread the Eio environment through server state, update hover handling to use the current analysis API, and extend LSP tests to initialize the server before running workspace requests. --- Makefile | 1 + dune-project | 4 +- lsp/src/compiler.ml | 31 + lsp/src/compiler_log.ml | 1075 +++++++++++++++++++++++++++ lsp/src/constants.ml | 14 + lsp/src/diagnostics.ml | 51 +- lsp/src/document.ml | 11 + lsp/src/document_store.ml | 30 +- lsp/src/dune | 5 +- lsp/src/hover.ml | 17 +- lsp/src/rescript_language_server.ml | 100 ++- lsp/src/server.ml | 78 +- lsp/src/source_dirs.ml | 91 +++ lsp/src/state.ml | 24 +- rescript-language-server.opam | 1 + tests/lsp_tests/test.ml | 25 +- 16 files changed, 1496 insertions(+), 62 deletions(-) create mode 100644 lsp/src/compiler.ml create mode 100644 lsp/src/compiler_log.ml create mode 100644 lsp/src/constants.ml create mode 100644 lsp/src/document.ml create mode 100644 lsp/src/source_dirs.ml diff --git a/Makefile b/Makefile index c9508cb8d06..7f726bede6a 100644 --- a/Makefile +++ b/Makefile @@ -182,6 +182,7 @@ test-lsp: lib echo "Building $${dir%/}..."; \ ( cd "$$dir" && yarn clean && yarn build ); \ done + @dune runtest @dune exec -- lsp-tests @if [ -n "$$(git ls-files --modified tests/lsp_tests/**/*.expected)" ]; then \ echo "The lsp_tests snapshot doesn't match. Double check that the output is correct, run 'make test-lsp' and stage the diff"; \ diff --git a/dune-project b/dune-project index 71c1c5f0df0..7a100fc98f5 100644 --- a/dune-project +++ b/dune-project @@ -89,4 +89,6 @@ (eio_main (>= 1.3)) analysis - dune)) + dune + (ppx_expect + (and :with-test (= 0.17.2))))) diff --git a/lsp/src/compiler.ml b/lsp/src/compiler.ml new file mode 100644 index 00000000000..597d6d41ee1 --- /dev/null +++ b/lsp/src/compiler.ml @@ -0,0 +1,31 @@ +module Uri_map = Map.Make (Lsp.Uri) + +let collect_diagnostics_from_log_file path = + let content = Eio.Path.load path in + Compiler_log.Parse.parse_log_content content + +let collect_diagnostics_from_log_using_source_dirs workspace_root + (state : State.t) = + let ( // ) = Filename.concat in + let workspace_root_path = workspace_root |> Lsp.Types.DocumentUri.to_path in + let path = + workspace_root_path // Constants.compiler_dir_partial_path + // Constants.sources_dirs + in + let build_roots = + Source_dirs.get_build_roots_from_file Eio.Path.(state.env#fs / path) + in + let diagnostics = + match build_roots with + | Some build_roots -> + build_roots + |> List.map (fun build_root -> + let compiler_log_path = + workspace_root_path // build_root // Constants.compiler_log + in + collect_diagnostics_from_log_file + Eio.Path.(state.env#fs / compiler_log_path)) + |> List.flatten + | None -> [] + in + diagnostics diff --git a/lsp/src/compiler_log.ml b/lsp/src/compiler_log.ml new file mode 100644 index 00000000000..dd52872c46e --- /dev/null +++ b/lsp/src/compiler_log.ml @@ -0,0 +1,1075 @@ +module Parse : sig + type filepath = Relative_path of string | Full_path of string + + type error = + | Syntax_error + | Warning + | Common_error (* type error, value can't be found *) + | Circular_dependency + | Unknow + + type diagnostic_entry = {error: error; diagnostic: Lsp.Types.Diagnostic.t} + + val parse_log_content : string -> (filepath * diagnostic_entry) list +end = struct + type position = {line: int; col: int} + + type range = {start_pos: position; end_pos: position} + + type filepath = Relative_path of string | Full_path of string + + type error = + | Syntax_error + | Warning + | Common_error + | Circular_dependency + | Unknow + + type diagnostic_entry = {error: error; diagnostic: Lsp.Types.Diagnostic.t} + + type location_format = Path_location | File_location + + let split_lines s = s |> String.split_on_char '\n' |> Array.of_list + + let is_blank s = String.trim s = "" + + let starts_with prefix s = + let prefix_len = String.length prefix in + String.length s >= prefix_len && String.sub s 0 prefix_len = prefix + + let ends_with suffix s = + let suffix_len = String.length suffix in + let len = String.length s in + len >= suffix_len && String.sub s (len - suffix_len) suffix_len = suffix + + let is_rescript_source_path s = + (not (String.contains s ' ')) + && List.exists + (fun suffix -> ends_with suffix s) + [".res"; ".resi"; ".re"; ".rei"] + + let filepath_of_path path = + if Filename.is_relative path then Relative_path path else Full_path path + + let zero_range = + {start_pos = {line = 0; col = 0}; end_pos = {line = 0; col = 0}} + + let parse_path_location line = + (* Supported formats: + + /path/file.res:3:9 + start = 3:9 + end = 3:9 + + /path/file.res:3:5-8 + start = 3:5 + end = 3:8 + + /path/file.res:1:8-2:3 + start = 1:8 + end = 2:3 + + /path/file.res + start = 0:0 + end = 0:0 + *) + let line = String.trim line in + + let point_re = Str.regexp "^\\(.+\\):\\([0-9]+\\):\\([0-9]+\\)$" in + let same_line_range_re = + Str.regexp "^\\(.+\\):\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\)$" + in + let cross_line_range_re = + Str.regexp + "^\\(.+\\):\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\):\\([0-9]+\\)$" + in + let make_location filepath start_line start_col end_line end_col = + Some + ( filepath_of_path (Str.matched_group filepath line), + { + start_pos = + { + line = Str.matched_group start_line line |> int_of_string; + col = Str.matched_group start_col line |> int_of_string; + }; + end_pos = + { + line = Str.matched_group end_line line |> int_of_string; + col = Str.matched_group end_col line |> int_of_string; + }; + } ) + in + + try + if Str.string_match cross_line_range_re line 0 then + make_location 1 2 3 4 5 + else if Str.string_match same_line_range_re line 0 then + make_location 1 2 3 2 4 + else if Str.string_match point_re line 0 then make_location 1 2 3 2 3 + else if is_rescript_source_path line then + Some (filepath_of_path line, zero_range) + else None + with Not_found | Failure _ -> + if is_rescript_source_path line then + Some (filepath_of_path line, zero_range) + else None + + let parse_file_location line = + (* Supported formats: + + File "/path/file.res", line 3, characters 5-8: + start = 3:5 + end = 3:8 + + File "/path/file.res", lines 11-13, characters 6-7: + start = 11:6 + end = 13:7 + *) + let line = String.trim line in + + let single_line_re = + Str.regexp + "^File \"\\([^\"]+\\)\", line \\([0-9]+\\), characters \ + \\([0-9]+\\)-\\([0-9]+\\):$" + in + let multi_line_re = + Str.regexp + "^File \"\\([^\"]+\\)\", lines \\([0-9]+\\)-\\([0-9]+\\), characters \ + \\([0-9]+\\)-\\([0-9]+\\):$" + in + + if Str.string_match single_line_re line 0 then + let filepath = Str.matched_group 1 line in + let line_number = Str.matched_group 2 line |> int_of_string in + let start_col = Str.matched_group 3 line |> int_of_string in + let end_col = Str.matched_group 4 line |> int_of_string in + Some + ( filepath_of_path filepath, + { + start_pos = {line = line_number; col = start_col}; + end_pos = {line = line_number; col = end_col}; + } ) + else if Str.string_match multi_line_re line 0 then + let filepath = Str.matched_group 1 line in + let start_line = Str.matched_group 2 line |> int_of_string in + let end_line = Str.matched_group 3 line |> int_of_string in + let start_col = Str.matched_group 4 line |> int_of_string in + let end_col = Str.matched_group 5 line |> int_of_string in + Some + ( filepath_of_path filepath, + { + start_pos = {line = start_line; col = start_col}; + end_pos = {line = end_line; col = end_col}; + } ) + else None + + let parse_location line = + match parse_path_location line with + | Some location -> Some (Path_location, location) + | None -> ( + match parse_file_location line with + | Some location -> Some (File_location, location) + | None -> None) + + let is_location_line line = + match parse_location line with + | Some _ -> true + | None -> false + + let is_source_code_line line = + (* Matches lines like: + 1 │ let a = 1 + 2 │ let b = "hi" + 11 | ......Todos { + | ...TodoItem + 46 ┆ module Input = { + *) + let rescript_re = Str.regexp "^[ \t]*[0-9]+[ \t]*│" in + let rescript_rei_re = Str.regexp "^[ \t]*[0-9]+[ \t]*┆" in + let ocaml_re = Str.regexp "^[ \t]*\\([0-9]+[ \t]*\\)?|" in + Str.string_match rescript_re line 0 + || Str.string_match rescript_rei_re line 0 + || Str.string_match ocaml_re line 0 + + let trim_empty_edges lines = + let rec drop_start = function + | [] -> [] + | x :: xs when is_blank x -> drop_start xs + | xs -> xs + in + + let rec drop_end xs = + match List.rev xs with + | [] -> [] + | x :: rest when is_blank x -> drop_end (List.rev rest) + | _ -> xs + in + + lines |> drop_start |> drop_end + + let find_title_index lines loc_index = + let rec loop i = + if i < 0 then None + else + let line = lines.(i) in + let trimmed = String.trim line in + + if is_blank line || starts_with "#Start" trimmed then loop (i - 1) + else Some i + in + loop (loc_index - 1) + + let severity_from_message lines = + let rec loop = function + | [] -> None + | line :: rest -> ( + let content = String.trim line in + if is_blank content || is_source_code_line content then loop rest + else + match content with + | other when String.starts_with ~prefix:"Warning " other -> + Some Lsp.Types.DiagnosticSeverity.Warning + | other when String.starts_with ~prefix:"Error" other -> + Some Lsp.Types.DiagnosticSeverity.Error + | _ -> None) + in + loop lines + + let is_diagnostic_message_start line = + let content = String.trim line in + String.starts_with ~prefix:"Warning " content + || String.starts_with ~prefix:"Error" content + + let kind_from_title title = + match title with + | "Syntax error!" -> Syntax_error + | "We've found a bug for you!" -> Common_error + | other when String.starts_with ~prefix:"Warning number" other -> Warning + | _ -> Unknow + + let kind_from_message lines = + let rec loop = function + | [] -> Unknow + | line :: rest -> + let content = String.trim line in + if is_blank content || is_source_code_line content then loop rest + else if String.starts_with ~prefix:"Warning " content then Warning + else if String.starts_with ~prefix:"Error" content then Unknow + else loop rest + in + loop lines + + let message_from_lines lines = + let rec filter_source_lines in_source_excerpt acc = function + | [] -> List.rev acc + | line :: rest -> + let trimmed = String.trim line in + if + is_location_line line + || starts_with "#Done" trimmed + || starts_with "#Start" trimmed + then filter_source_lines false acc rest + else if is_source_code_line line then filter_source_lines true acc rest + else if in_source_excerpt then + if is_diagnostic_message_start line then + filter_source_lines false (line :: acc) rest + else if is_blank line then + filter_source_lines false (line :: acc) rest + else filter_source_lines true acc rest + else filter_source_lines false (line :: acc) rest + in + lines + |> filter_source_lines false [] + |> trim_empty_edges |> List.map String.trim |> String.concat "\n" + + let unique_preserve_order items = + let rec loop seen acc = function + | [] -> List.rev acc + | item :: rest -> + if List.mem item seen then loop seen acc rest + else loop (item :: seen) (item :: acc) rest + in + loop [] [] items + + let collect_matches re group line = + let rec loop start acc = + try + ignore (Str.search_forward re line start); + let matched = Str.matched_group group line in + loop (Str.match_end ()) (matched :: acc) + with Not_found -> List.rev acc + in + loop 0 [] + + let source_path_from_artifact_path path = + if ends_with ".cmj" path then + String.sub path 0 (String.length path - 4) ^ ".res" + else path + + let parse_dependency_cycle_paths message_lines = + let paren_source_path_re = + Str.regexp "(\\([^()]+\\.\\(res\\|resi\\|re\\|rei\\)\\))" + in + let artifact_path_re = Str.regexp "\\([^ ]+\\.cmj\\)" in + let source_paths = + message_lines |> List.concat_map (collect_matches paren_source_path_re 1) + in + match source_paths with + | _ :: _ -> unique_preserve_order source_paths + | [] -> + message_lines + |> List.concat_map (collect_matches artifact_path_re 1) + |> List.map source_path_from_artifact_path + |> unique_preserve_order + + let parse_dependency_cycle_entries lines len = + let rec collect_until_done i acc = + if i >= len then (List.rev acc, i) + else + let trimmed = String.trim lines.(i) in + if starts_with "#Done" trimmed then (List.rev acc, i) + else collect_until_done (i + 1) (lines.(i) :: acc) + in + let rec loop i acc = + if i >= len then List.rev acc + else + let trimmed = String.trim lines.(i) in + if starts_with "Can't continue... Found a circular dependency" trimmed + then + let message_lines, next_i = collect_until_done i [] in + let message = + message_lines |> trim_empty_edges |> List.map String.trim + |> String.concat "\n" + in + let paths = parse_dependency_cycle_paths message_lines in + let entries = + paths + |> List.map (fun filepath -> + ( filepath_of_path filepath, + Circular_dependency, + zero_range, + Lsp.Types.DiagnosticSeverity.Error, + message )) + in + loop (next_i + 1) (List.rev_append entries acc) + else if starts_with "FAILED: dependency cycle:" trimmed then + let message = trimmed in + let paths = parse_dependency_cycle_paths [trimmed] in + let entries = + paths + |> List.map (fun filepath -> + ( filepath_of_path filepath, + Circular_dependency, + zero_range, + Lsp.Types.DiagnosticSeverity.Error, + message )) + in + loop (i + 1) (List.rev_append entries acc) + else loop (i + 1) acc + in + loop 0 [] + + let make_diagnostic ?severity ~range ~message () = + (* -1 because lsp line and col is 0 based *) + let minus_one v = if v == 0 then v else v - 1 in + Lsp.Types.Diagnostic.create ?severity ~source:"ReScript" + ~range: + (Lsp.Types.Range.create + ~start: + (Lsp.Types.Position.create + ~line:(range.start_pos.line |> minus_one) + ~character:(range.start_pos.col |> minus_one)) + ~end_: + (Lsp.Types.Position.create + ~line:(range.end_pos.line |> minus_one) + ~character:range.end_pos.col)) + ~message:(`String message) () + + let parse_log_content (content : string) = + let lines = split_lines content in + let len = Array.length lines in + + let diagnostics = + let rec loop i acc = + if i >= len then List.rev acc + else + match parse_location lines.(i) with + | Some (location_format, location) -> + let title_index = + match location_format with + | Path_location -> find_title_index lines i + | File_location -> None + in + loop (i + 1) ((i, title_index, location_format, location) :: acc) + | None -> loop (i + 1) acc + in + loop 0 [] + in + + let rec build entries = + match entries with + | [] -> [] + | (loc_index, title_index, location_format, (filepath, range)) :: rest -> + let next_boundary = + match rest with + | (next_loc_index, next_title_index, next_location_format, _) :: _ + -> ( + match next_location_format with + | File_location -> next_loc_index + | Path_location -> ( + match next_title_index with + | Some i -> i + | None -> next_loc_index)) + | [] -> len + in + + let message_start = + match title_index with + | Some i -> i + 1 + | None -> loc_index + 1 + in + + let raw_message_lines = + let rec collect i acc = + if i >= next_boundary then List.rev acc + else collect (i + 1) (lines.(i) :: acc) + in + collect message_start [] + in + + let severity = + match location_format with + | File_location -> severity_from_message raw_message_lines + | Path_location -> ( + match title_index with + | Some i -> ( + let content = String.trim lines.(i) in + match content with + | "Syntax error!" | "We've found a bug for you!" -> + Some Lsp.Types.DiagnosticSeverity.Error + | other when String.starts_with ~prefix:"Warning number" other -> + Some Lsp.Types.DiagnosticSeverity.Warning + | _ -> None) + | None -> None) + in + + let error = + match location_format with + | File_location -> kind_from_message raw_message_lines + | Path_location -> ( + match title_index with + | Some i -> kind_from_title (String.trim lines.(i)) + | None -> kind_from_message raw_message_lines) + in + + let message = message_from_lines raw_message_lines in + + let diagnostic = make_diagnostic ?severity ~range ~message () in + (filepath, {error; diagnostic}) :: build rest + in + + let dependency_cycle_diagnostics = + parse_dependency_cycle_entries lines len + |> List.map (fun (filepath, error, range, severity, message) -> + let diagnostic = make_diagnostic ~severity ~range ~message () in + (filepath, {error; diagnostic})) + in + + build diagnostics @ dependency_cycle_diagnostics +end + +(* TODO: Add more tests (fatal error), gentype warning, configured as error *) +let%expect_test "parse log" = + let print_logs logs = + logs + |> List.iter + (fun ((filepath : Parse.filepath), (entry : Parse.diagnostic_entry)) -> + let filepath = + match filepath with + | Parse.Relative_path p -> Printf.sprintf "Relative_path(%s)" p + | Full_path p -> Printf.sprintf "Full_path(%s)" p + in + print_endline + ((match entry.error with + | Syntax_error -> "Syntax_error" + | Warning -> "Warning" + | Unknow -> "Unknow" + | Circular_dependency -> "Circular_dependency" + | Common_error -> "Common_error") + ^ " - " ^ filepath); + Lsp.Types.Diagnostic.yojson_of_t entry.diagnostic + |> Yojson.Safe.pretty_to_string |> print_endline; + print_newline ()) + in + let example_log_1 = + {| + #Start(1600519680823) + + Syntax error! + /Users/chenglou/github/reason-react/src/test.res:1:8-2:3 + + 1 │ let a = + 2 │ let b = + 3 │ + + This let-binding misses an expression + + + Warning number 8 + /Users/chenglou/github/reason-react/src/test.res:3:5-8 + + 1 │ let a = j`😀` + 2 │ let b = `😀` + 3 │ let None = None + 4 │ let bla: int = " + 5 │ hi + + You forgot to handle a possible case here, for example: + Some _ + + + We've found a bug for you! + /Users/chenglou/github/reason-react/src/test.res:3:9 + + 1 │ let a = 1 + 2 │ let b = "hi" + 3 │ let a = b + 1 + + This has type: string + Somewhere wanted: int + + #Done(1600519680836) + |} + in + + Parse.parse_log_content example_log_1 |> print_logs; + [%expect + {| + Syntax_error - Full_path(/Users/chenglou/github/reason-react/src/test.res) + { + "message": "This let-binding misses an expression", + "range": { + "end": { "character": 3, "line": 1 }, + "start": { "character": 7, "line": 0 } + }, + "severity": 1, + "source": "ReScript" + } + + Warning - Full_path(/Users/chenglou/github/reason-react/src/test.res) + { + "message": "You forgot to handle a possible case here, for example:\nSome _", + "range": { + "end": { "character": 8, "line": 2 }, + "start": { "character": 4, "line": 2 } + }, + "severity": 2, + "source": "ReScript" + } + + Common_error - Full_path(/Users/chenglou/github/reason-react/src/test.res) + { + "message": "This has type: string\nSomewhere wanted: int", + "range": { + "end": { "character": 9, "line": 2 }, + "start": { "character": 8, "line": 2 } + }, + "severity": 1, + "source": "ReScript" + } + |}]; + + let example_log_2 = + {| + #Start(1780532423603) + #Done(1780532423840) + + |} + in + + Parse.parse_log_content example_log_2 |> print_logs; + [%expect {| |}]; + + (* https://github.com/rescript-lang/rescript-vscode/issues/386#issuecomment-1221093517 *) + let example_log_3 = + {| + #Start(1660943070627) + File "/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/fragmentsUsage/Fragments.res", lines 11-13, characters 6-7: + 11 | ......Todos { + | ...TodoItem + | } + 13 | ... + Warning 22 [preprocessor]: Field "allTodos" has been deprecated. Reason: null + File "/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/clientUsage/PromiseChaining.res", lines 17-21, characters 6-7: + 17 | ......os: allTodos { + | id + | text + | completed + | } + 21 | ... + Warning 22 [preprocessor]: Field "allTodos" has been deprecated. Reason: null + File "/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/clientUsage/ClientBasics.res", lines 18-22, characters 6-7: + 18 | ......os: allTodos { + | id + | text + | completed + | } + 22 | ... + Warning 22 [preprocessor]: Field "allTodos" has been deprecated. Reason: null + File "/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/docs/Docs.res", lines 7-11, characters 6-7: + 7 | ......os: allTodos { + | id + | text + | completed + | } + 11 | ... + Warning 22 [preprocessor]: Field "allTodos" has been deprecated. Reason: null + File "/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/fragmentsUsage/Query_Fragments.res", lines 6-9, characters 6-7: + 6 | ......os: allTodos { + | # This references the TodoItem fragment definition module above! + | ...TodoItem + | } + 9 | ... + Warning 22 [preprocessor]: Field "allTodos" has been deprecated. Reason: null + File "/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/hooksUsage/Mutation.res", lines 18-22, characters 6-7: + 18 | ......os: allTodos { + | id + | completed + | text + | } + 22 | ... + Warning 22 [preprocessor]: Field "allTodos" has been deprecated. Reason: null + File "/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/hooksUsage/Query_Lazy.res", lines 3-7, characters 6-7: + 3 | ......os: allTodos { + | id + | text + | completed + | } + 7 | ... + Warning 22 [preprocessor]: Field "allTodos" has been deprecated. Reason: null + File "/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/hooksUsage/Query_OverlySimple.res", lines 3-7, characters 4-5: + 3 | ....os: allTodos { + | id + | text + | completed + | } + 7 | . + Warning 22 [preprocessor]: Field "allTodos" has been deprecated. Reason: null + File "/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/hooksUsage/Query_SubscribeToMore.res", lines 5-9, characters 6-7: + 5 | ......os: allTodos { + | id + | completed + | text + | } + 9 | ... + Warning 22 [preprocessor]: Field "allTodos" has been deprecated. Reason: null + File "/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/hooksUsage/Query_Typical.res", lines 4-8, characters 6-7: + 4 | ......os: allTodos { + | id + | text + | completed + | } + 8 | ... + Warning 22 [preprocessor]: Field "allTodos" has been deprecated. Reason: null + #Done(1660943070848) + |} + in + + Parse.parse_log_content example_log_3 |> print_logs; + [%expect + {| + Warning - Full_path(/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/fragmentsUsage/Fragments.res) + { + "message": "Warning 22 [preprocessor]: Field \"allTodos\" has been deprecated. Reason: null", + "range": { + "end": { "character": 7, "line": 12 }, + "start": { "character": 5, "line": 10 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/clientUsage/PromiseChaining.res) + { + "message": "Warning 22 [preprocessor]: Field \"allTodos\" has been deprecated. Reason: null", + "range": { + "end": { "character": 7, "line": 20 }, + "start": { "character": 5, "line": 16 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/clientUsage/ClientBasics.res) + { + "message": "Warning 22 [preprocessor]: Field \"allTodos\" has been deprecated. Reason: null", + "range": { + "end": { "character": 7, "line": 21 }, + "start": { "character": 5, "line": 17 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/docs/Docs.res) + { + "message": "Warning 22 [preprocessor]: Field \"allTodos\" has been deprecated. Reason: null", + "range": { + "end": { "character": 7, "line": 10 }, + "start": { "character": 5, "line": 6 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/fragmentsUsage/Query_Fragments.res) + { + "message": "Warning 22 [preprocessor]: Field \"allTodos\" has been deprecated. Reason: null", + "range": { + "end": { "character": 7, "line": 8 }, + "start": { "character": 5, "line": 5 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/hooksUsage/Mutation.res) + { + "message": "Warning 22 [preprocessor]: Field \"allTodos\" has been deprecated. Reason: null", + "range": { + "end": { "character": 7, "line": 21 }, + "start": { "character": 5, "line": 17 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/hooksUsage/Query_Lazy.res) + { + "message": "Warning 22 [preprocessor]: Field \"allTodos\" has been deprecated. Reason: null", + "range": { + "end": { "character": 7, "line": 6 }, + "start": { "character": 5, "line": 2 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/hooksUsage/Query_OverlySimple.res) + { + "message": "Warning 22 [preprocessor]: Field \"allTodos\" has been deprecated. Reason: null", + "range": { + "end": { "character": 5, "line": 6 }, + "start": { "character": 3, "line": 2 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/hooksUsage/Query_SubscribeToMore.res) + { + "message": "Warning 22 [preprocessor]: Field \"allTodos\" has been deprecated. Reason: null", + "range": { + "end": { "character": 7, "line": 8 }, + "start": { "character": 5, "line": 4 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/hooksUsage/Query_Typical.res) + { + "message": "Warning 22 [preprocessor]: Field \"allTodos\" has been deprecated. Reason: null", + "range": { + "end": { "character": 7, "line": 7 }, + "start": { "character": 5, "line": 3 } + }, + "severity": 2, + "source": "ReScript" + } + |}]; + + (* https://github.com/rescript-lang/rescript-vscode/issues/86#issuecomment-786186698 *) + let example_log_4 = + {|#Start(1614285167013) + + Warning number 33 + /home/misha/projects/productionmason/web/auth/src/ErrorHandlingMiddleware.res:1:1-15 + + 1 │ open CommonBase + 2 │ + 3 │ external jsExnToExpressError: Js.Exn.t => Express.Error.t = "%identity" + + unused open CommonBase. + + + Warning number 27 + /home/misha/projects/productionmason/web/auth/src/config/Config.res:10:22-27 + + 8 │ external stringifyAnyWithSpace: ('a, @bs.as(json`null`) _, int) => str + ing = "stringify" + 9 │ + 10 │ let validateConfig = config => { + 11 │ let googleApplicationCredentialsPath = + 12 │ NodeJs.Process.env(NodeJs.Process.process)->Js.Dict.get("GOOGLE_AP + PLICATION_CREDENTIALS") + + unused variable config. + + + Warning number 34 + /home/misha/projects/productionmason/web/auth/src/express-handler/ExpressHandler.re:48:5-26 + + 46 ┆ module Input = { + 47 ┆ [@decco] + 48 ┆ type t = Request.input; + 49 ┆ }; + 50 ┆ + + unused type t. + + + Warning number 32 + /home/misha/projects/productionmason/web/auth/src/express-handler/ExpressHandler.re + + unused value t_encode. + + + We've found a bug for you! + /home/misha/projects/productionmason/web/auth/tests/Auth_Test.res:224:45 + + 222 ┆ ->AsyncResult.mapOk(x => { + 223 ┆ expect(x.data.users->Array.length)->toBeGreaterThan(0) + 224 ┆ expect(x.data.users->Array.getExn(0).last_name)->toBe(Some("Glenliv + et")) + 225 ┆ Ok() + 226 ┆ }) + + This has type: int + Somewhere wanted: array<'a> + + #Done(1614285167075)|} + in + + Parse.parse_log_content example_log_4 |> print_logs; + [%expect + {| + Warning - Full_path(/home/misha/projects/productionmason/web/auth/src/ErrorHandlingMiddleware.res) + { + "message": "unused open CommonBase.", + "range": { + "end": { "character": 15, "line": 0 }, + "start": { "character": 0, "line": 0 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/misha/projects/productionmason/web/auth/src/config/Config.res) + { + "message": "unused variable config.", + "range": { + "end": { "character": 27, "line": 9 }, + "start": { "character": 21, "line": 9 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/misha/projects/productionmason/web/auth/src/express-handler/ExpressHandler.re) + { + "message": "unused type t.", + "range": { + "end": { "character": 26, "line": 47 }, + "start": { "character": 4, "line": 47 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/misha/projects/productionmason/web/auth/src/express-handler/ExpressHandler.re) + { + "message": "unused value t_encode.", + "range": { + "end": { "character": 0, "line": 0 }, + "start": { "character": 0, "line": 0 } + }, + "severity": 2, + "source": "ReScript" + } + + Common_error - Full_path(/home/misha/projects/productionmason/web/auth/tests/Auth_Test.res) + { + "message": "This has type: int\nSomewhere wanted: array<'a>", + "range": { + "end": { "character": 45, "line": 223 }, + "start": { "character": 44, "line": 223 } + }, + "severity": 1, + "source": "ReScript" + } + |}]; + + let example_log_5 = + {|#Start(1780595107359) + + Can't continue... Found a circular dependency in your code: + Demo (src/Demo.res) + → Other (src/Other.res) + → Demo (src/Demo.res) + Possible solutions: + - Extract shared code into a new module both depend on. + #Done(1780595107364) + |} + in + + Parse.parse_log_content example_log_5 |> print_logs; + [%expect + {| + Circular_dependency - Relative_path(src/Demo.res) + { + "message": "Can't continue... Found a circular dependency in your code:\nDemo (src/Demo.res)\n→ Other (src/Other.res)\n→ Demo (src/Demo.res)\nPossible solutions:\n- Extract shared code into a new module both depend on.", + "range": { + "end": { "character": 0, "line": 0 }, + "start": { "character": 0, "line": 0 } + }, + "severity": 1, + "source": "ReScript" + } + + Circular_dependency - Relative_path(src/Other.res) + { + "message": "Can't continue... Found a circular dependency in your code:\nDemo (src/Demo.res)\n→ Other (src/Other.res)\n→ Demo (src/Demo.res)\nPossible solutions:\n- Extract shared code into a new module both depend on.", + "range": { + "end": { "character": 0, "line": 0 }, + "start": { "character": 0, "line": 0 } + }, + "severity": 1, + "source": "ReScript" + } + |}]; + + let example_log_6 = + {|#Start(1780595245481) + FAILED: dependency cycle: src/Demo.cmj -> src/Other.cmj -> src/Demo.cmj. + #Done(1780595245488)|} + in + + Parse.parse_log_content example_log_6 |> print_logs; + [%expect + {| + Circular_dependency - Relative_path(src/Demo.res) + { + "message": "FAILED: dependency cycle: src/Demo.cmj -> src/Other.cmj -> src/Demo.cmj.", + "range": { + "end": { "character": 0, "line": 0 }, + "start": { "character": 0, "line": 0 } + }, + "severity": 1, + "source": "ReScript" + } + + Circular_dependency - Relative_path(src/Other.res) + { + "message": "FAILED: dependency cycle: src/Demo.cmj -> src/Other.cmj -> src/Demo.cmj.", + "range": { + "end": { "character": 0, "line": 0 }, + "start": { "character": 0, "line": 0 } + }, + "severity": 1, + "source": "ReScript" + } + |}]; + + let example_log_7 = + {|#Start(1780595410580) + + We've found a bug for you! + /tmp/my-rescript-app/src/Demo.res:1:9-15 + + 1 │ let a = Other.a + 2 │ + + The value a can't be found in Other + + FAILED: cannot make progress due to previous errors. + #Done(1780595410597)|} + in + + Parse.parse_log_content example_log_7 |> print_logs; + [%expect + {| + Common_error - Full_path(/tmp/my-rescript-app/src/Demo.res) + { + "message": "The value a can't be found in Other\n\nFAILED: cannot make progress due to previous errors.", + "range": { + "end": { "character": 15, "line": 0 }, + "start": { "character": 8, "line": 0 } + }, + "severity": 1, + "source": "ReScript" + } + |}]; + + let example_log_8 = + {|#Start(1780603624843) + Error in lsp-test: + + Syntax error! + /home/pedro/Desktop/projects/lsp-test/src/ArrayUtils.res:1:41-2:0 + + 1 │ let empty = arr => Array.length(arr) === + 2 │ + + Did you forget to write an expression here? + + #Done(1780603624849)|} + in + Parse.parse_log_content example_log_8 |> print_logs; + [%expect + {| + Syntax_error - Full_path(/home/pedro/Desktop/projects/lsp-test/src/ArrayUtils.res) + { + "message": "Did you forget to write an expression here?", + "range": { + "end": { "character": 0, "line": 1 }, + "start": { "character": 40, "line": 0 } + }, + "severity": 1, + "source": "ReScript" + } + |}]; + + let example_log_9 = + {|#Start(1780630901455) + + We've found a bug for you! + /home/pedro/Desktop/projects/lsp-test/src/ArrayUtils.res:1:41-43 + + 1 │ let empty = arr => Array.length(arr) == "2"; + 2 │ + + This has type: string + But it's being compared to something of type: int + + You can only compare things of the same type. + + You can convert string to int with Int.fromString. + + #Done(1780630901468)|} + in + + Parse.parse_log_content example_log_9 |> print_logs; + [%expect + {| + Common_error - Full_path(/home/pedro/Desktop/projects/lsp-test/src/ArrayUtils.res) + { + "message": "This has type: string\nBut it's being compared to something of type: int\n\nYou can only compare things of the same type.\n\nYou can convert string to int with Int.fromString.", + "range": { + "end": { "character": 43, "line": 0 }, + "start": { "character": 40, "line": 0 } + }, + "severity": 1, + "source": "ReScript" + } + |}] diff --git a/lsp/src/constants.ml b/lsp/src/constants.ml new file mode 100644 index 00000000000..9a129097f4a --- /dev/null +++ b/lsp/src/constants.ml @@ -0,0 +1,14 @@ +let ( // ) = Filename.concat + +let rescript_json = "rescript.json" +let bsconfig_json = "bsconfig.json" +let compiler_dir_partial_path = "lib" // "bs" +let compiler_ocaml_dir_partial_path = "lib" // "ocaml" +let compiler_log = ".compiler.log" +let sources_dirs = ".sourcedirs.json" +let compiler_log_partial_path = compiler_dir_partial_path // compiler_log +let compiler_info_partial_path = + compiler_dir_partial_path // "compiler-info.json" +let build_ninja_partial_path = compiler_dir_partial_path // "build.ninja" +let rewatch_lock_partial_path = "lib" // "rewatch.lock" +let rescript_lock_partial_path = "lib" // "rescript.lock" diff --git a/lsp/src/diagnostics.ml b/lsp/src/diagnostics.ml index de172eda24b..788c6b69ee4 100644 --- a/lsp/src/diagnostics.ml +++ b/lsp/src/diagnostics.ml @@ -1,5 +1,50 @@ -module UriMap = Map.Make (Lsp.Uri) +module Uri_map = Map.Make (Lsp.Uri) -type t = Lsp.Types.Diagnostic.t list UriMap.t +type t = { + diagnostics: Lsp.Types.Diagnostic.t list Uri_map.t; + send: Lsp.Types.PublishDiagnosticsParams.t list -> unit; +} -let create () = UriMap.empty +let create ~diagnostics ~send = {diagnostics; send} + +let set ~(diagnostics : Lsp.Types.Diagnostic.t list Uri_map.t) t = + let diagnostics = + Uri_map.merge + (fun _ existing incoming -> + match (existing, incoming) with + | None, None -> Some [] + | Some _, None -> Some [] + | None, Some diagnostics -> Some diagnostics + | Some _, Some diagnostics -> Some diagnostics) + t.diagnostics diagnostics + in + {t with diagnostics} + +let send t = + Uri_map.iter + (fun uri diagnostics -> + t.send [Lsp.Types.PublishDiagnosticsParams.create ~uri ~diagnostics ()]) + t.diagnostics + +let convert_to_lsp (workspace_root : Lsp.Types.DocumentUri.t) diagnostics = + let workspace_root_path = workspace_root |> Lsp.Types.DocumentUri.to_path in + diagnostics + |> List.fold_left + (fun acc + (filepath, (diagnostic_entry : Compiler_log.Parse.diagnostic_entry)) + -> + let document_uri = + match filepath with + | Compiler_log.Parse.Relative_path p -> + Lsp.Types.DocumentUri.of_path + (Filename.concat workspace_root_path p) + | Full_path p -> Lsp.Types.DocumentUri.of_path p + in + + Uri_map.update document_uri + (function + | None -> Some [diagnostic_entry.diagnostic] + | Some diagnostics -> + Some (diagnostic_entry.diagnostic :: diagnostics)) + acc) + Uri_map.empty diff --git a/lsp/src/document.ml b/lsp/src/document.ml new file mode 100644 index 00000000000..61d443a1283 --- /dev/null +++ b/lsp/src/document.ml @@ -0,0 +1,11 @@ +type kind = Analysis.Files.classified_file +let kind uri = + match Filename.extension (Lsp.Types.DocumentUri.to_string uri) with + | ".res" -> Analysis.Files.Res + | ".resi" -> Analysis.Files.Resi + | other -> + Jsonrpc.Response.Error.raise + (Jsonrpc.Response.Error.make ~code:InvalidRequest + ~message:"unsupported file extension" + ~data:(`Assoc [("extension", `String other)]) + ()) diff --git a/lsp/src/document_store.ml b/lsp/src/document_store.ml index d818d61f60d..1ee3c141d20 100644 --- a/lsp/src/document_store.ml +++ b/lsp/src/document_store.ml @@ -1,25 +1,41 @@ -(* 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 raise ~message = + Jsonrpc.Response.Error.raise + (Jsonrpc.Response.Error.make ~code:InternalError ~message ()) + let open_document t ~uri ~text ~version = - Hashtbl.add t.documents uri {text; version}; + (match Hashtbl.mem t.documents uri with + | false -> Hashtbl.add t.documents uri {text; version} + | true -> + raise + ~message: + (Printf.sprintf "Document store already has %s to open" + (Lsp.Uri.to_string uri))); 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))) + ~message: + (Printf.sprintf "Document store not found %s to update" + (Lsp.Uri.to_string uri)) | Some _ -> Hashtbl.replace t.documents uri {text; version}); t let remove_document t ~uri = - Hashtbl.remove t.documents uri; + (match Hashtbl.mem t.documents uri with + | true -> Hashtbl.remove t.documents uri + | false -> + raise + ~message: + (Printf.sprintf "Document store not found %s to remove" + (Lsp.Uri.to_string uri))); t let get_document t ~uri = @@ -27,4 +43,6 @@ let get_document t ~uri = | Some doc -> doc | None -> raise - (Failure (Printf.sprintf "Document not found: %s" (Lsp.Uri.to_string uri))) + ~message: + (Printf.sprintf "Document store not found %s to get" + (Lsp.Uri.to_string uri)) diff --git a/lsp/src/dune b/lsp/src/dune index 486415966af..17b08c9203a 100644 --- a/lsp/src/dune +++ b/lsp/src/dune @@ -1,5 +1,6 @@ (library (name rescript_language_server) (libraries lsp eio eio_main analysis) - (flags - (-w "-9"))) + (inline_tests) + (preprocess + (pps ppx_expect))) diff --git a/lsp/src/hover.ml b/lsp/src/hover.ml index 32eb4670fd7..98a40a5aefd 100644 --- a/lsp/src/hover.ml +++ b/lsp/src/hover.ml @@ -2,15 +2,14 @@ open Lsp.Types let create ~(position : Position.t) ~(uri : DocumentUri.t) (server : State.t Server.t) = - let path = DocumentUri.to_path uri in - let pos = (position.line, position.character) in + (* TODO: should be a config *) + let supports_markdown_links = true in - (* NOTE: Should be a config *) - let supportsMarkdownLinks = true in - let debug = false in - let open Analysis in let source = (Document_store.get_document ~uri server.state.store).text in - let kindFile = Files.classifySourceFile path in - let full = Cmt.loadFullCmtFromPath ~path in + let full = + Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) + in - Commands.hover ~source ~kindFile ~pos ~debug ~supportsMarkdownLinks ~full + Analysis.Commands.hover ~source ~kind_file:(Document.kind uri) + ~pos:(position.line, position.character) + ~debug:false ~supports_markdown_links ~full diff --git a/lsp/src/rescript_language_server.ml b/lsp/src/rescript_language_server.ml index b6530ddc481..840117b024c 100644 --- a/lsp/src/rescript_language_server.ml +++ b/lsp/src/rescript_language_server.ml @@ -1,4 +1,4 @@ -let initialization (client_capabilities : Lsp.Types.ClientCapabilities.t) = +let initialization (_client_capabilities : Lsp.Types.ClientCapabilities.t) = let open Lsp.Types in let textDocumentSync = `TextDocumentSyncOptions @@ -17,18 +17,29 @@ let initialization (client_capabilities : Lsp.Types.ClientCapabilities.t) = in InitializeResult.create ~capabilities ~serverInfo () -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 get_updated_diagnostics (state : State.t) = + let workspace_root = State.workspace_root state in + let diagnostics = + Compiler.collect_diagnostics_from_log_using_source_dirs workspace_root state + |> Diagnostics.convert_to_lsp workspace_root + in + Diagnostics.set ~diagnostics (State.diagnostics state) + +let on_initialize (params : Lsp.Types.InitializeParams.t) + (server : State.t Server.t) = + let state = Server.state server in + + let diagnostics = + Diagnostics.create ~diagnostics:Diagnostics.Uri_map.empty + ~send:(fun publish_diagnostics -> + publish_diagnostics + |> List.iter (fun publish_diagnostic_params -> + Server.notification + (Lsp.Server_notification.PublishDiagnostics + publish_diagnostic_params) server)) + in let state = State.initialize state ~params ~diagnostics in + let initialization_info = initialization params.capabilities in (initialization_info, state) let on_request (Lsp.Client_request.E request) (server : State.t Server.t) = @@ -36,10 +47,10 @@ let on_request (Lsp.Client_request.E request) (server : State.t Server.t) = 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 + let initialization_info, state = on_initialize params server in (ok initialization_info, state) | Shutdown -> (ok (), state) - | TextDocumentHover {position; textDocument = {uri}} -> + | TextDocumentHover {position; textDocument = {uri}; _} -> (ok (Hover.create ~position ~uri server), state) | _ -> let err = @@ -56,24 +67,61 @@ let on_notification notification (server : State.t Server.t) = | 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) *) + let diagnostics = get_updated_diagnostics state in + diagnostics |> Diagnostics.send; + {state with store} |> State.update_diagnostics diagnostics + | TextDocumentDidChange _ -> state | TextDocumentDidClose {textDocument = {uri; _}} -> - (* TODO: - * remove state diagnostics - * send updated diagnostics? - *) let store = Document_store.remove_document ~uri state.store in - {state with store} + let diagnostics = get_updated_diagnostics state in + diagnostics |> Diagnostics.send; + {state with store} |> State.update_diagnostics diagnostics + | Initialized -> + let open Lsp.Types in + (* Register dynamic file watchers for compiler log files. + ReScript writes one .compiler.log per build root. In monorepos, + .sourcedirs.json contains the build_root entries for each subpackage, + so use it to watch every generated compiler log and refresh diagnostics + when any of them changes. *) + let watchers = + [WatchKind.Create; Change; Delete] + |> List.map (fun kind -> + FileSystemWatcher.create + ~kind + (* NOTE: Clients dont send notification `workspace/didChangeWatchedFiles` + when pattern is a relative path `lib/bs/.compiler.log` of full path + `{workspace_root}/lib/bs/.compiler.log`. The glob should start with `**` + *) + ~globPattern:(`Pattern ("**/lib/bs/" ^ Constants.compiler_log)) + ()) + in + + let registerOptions = + DidChangeWatchedFilesRegistrationOptions.create ~watchers + |> DidChangeWatchedFilesRegistrationOptions.yojson_of_t + in + let registration = + Registration.create ~id:"rescript_file_watchers" + ~method_:"workspace/didChangeWatchedFiles" ~registerOptions () + in + let params = RegistrationParams.create ~registrations:[registration] in + Server.request (Lsp.Server_request.ClientRegisterCapability params) server; + + state + | DidChangeWatchedFiles _ -> + (* Do not limit diagnostics to the path reported by + DidChangeWatchedFilesParams. In monorepos, a build in one subpackage + can change diagnostics that should be shown for files in another + subpackage. Re-read every compiler log listed in .sourcedirs.json so + stale errors are cleared and cross-package diagnostics stay in sync. *) + let diagnostics = get_updated_diagnostics state in + diagnostics |> Diagnostics.send; + state |> State.update_diagnostics diagnostics | Exit -> state | _ -> state let main () = Eio_main.run (fun env -> - let state = State.create ~store:(Document_store.create ()) in + let state = State.create ~store:(Document_store.create ()) ~env in Server.listen ~input:env#stdin ~output:env#stdout ~on_request ~on_notification ~state ~env) diff --git a/lsp/src/server.ml b/lsp/src/server.ml index d2c4edc0977..6a4262a826f 100644 --- a/lsp/src/server.ml +++ b/lsp/src/server.ml @@ -97,29 +97,79 @@ let notification_of_jsonrpc notification = | Ok notification -> notification | Error error -> raise (Lsp.Io.Error error) -type 'a t = {channel: Chan.output; env: Eio_unix.Stdenv.base; state: 'a} +module Request_id = struct + type t = Jsonrpc.Id.t + + let equal = Jsonrpc.Id.equal + let hash = Jsonrpc.Id.hash +end + +module Request_id_table = Hashtbl.Make (Request_id) + +type pending_request = Pending : 'a Lsp.Server_request.t -> pending_request + +type request_context = { + mutable next_id: int; + pending: pending_request Request_id_table.t; +} + +type 'a t = { + channel: Chan.output; + env: Eio_unix.Stdenv.base; + state: 'a; + request_context: request_context; +} let state t = t.state let respond server response = Io.await @@ Lsp_Io.write server.channel @@ Response response -let notification server notification = +let notification notification server = 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 +let request request server = + let id = `Int server.request_context.next_id in + server.request_context.next_id <- server.request_context.next_id + 1; + Request_id_table.add server.request_context.pending id (Pending request); + let request = Lsp.Server_request.to_jsonrpc_request request ~id in + Io.await @@ Lsp_Io.write server.channel @@ Request request + +let handle_response (response : Jsonrpc.Response.t) server = + match + Request_id_table.find_opt server.request_context.pending response.id + with + | None -> () + | Some (Pending request) -> ( + Request_id_table.remove server.request_context.pending response.id; + match response.result with + | Ok json -> ( + match Lsp.Server_request.response_of_json request json with + | _ -> () + | exception _ -> ()) + | Error _ -> ()) + +let log_message_notification ?(kind = Lsp.Types.MessageType.Debug) message + server = + notification (Lsp.Server_notification.LogMessage (Lsp.Types.LogMessageParams.create ~type_:kind ~message)) + server + +let show_message_notification ?(kind = Lsp.Types.MessageType.Info) message + server = + notification + (Lsp.Server_notification.ShowMessage + (Lsp.Types.ShowMessageParams.create ~type_:kind ~message)) + server 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 (Failure "Server.input_loop") + | exception _ -> raise (Failure "Server.input_loop") | None -> () let listen ~input ~output ~on_request ~on_notification ~state ~env = @@ -142,18 +192,28 @@ let listen ~input ~output ~on_request ~on_notification ~state ~env = in let input = Chan.of_source input in Chan.with_sink output (fun channel -> - let server = {channel; state; env} in + let request_context = + {next_id = 1; pending = Request_id_table.create 16} + in input_loop ~input ~state (fun state packet -> + let server = {channel; state; env; request_context} in match packet with | Notification notification -> handle_notification server notification | Request request -> handle_request server request | Batch_call calls -> List.fold_left (fun state call -> + let server = {channel; state; env; request_context} in 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"))) + | Response response -> + handle_response response server; + state + | Batch_response responses -> + List.iter + (fun response -> handle_response response server) + responses; + state)) diff --git a/lsp/src/source_dirs.ml b/lsp/src/source_dirs.ml new file mode 100644 index 00000000000..03819a23cc4 --- /dev/null +++ b/lsp/src/source_dirs.ml @@ -0,0 +1,91 @@ +let get_build_roots_from_json json = + let build_roots = + match json with + | `Assoc fields -> ( + match List.assoc_opt "cmt_scan" fields with + | Some (`List cmt_scan_items) -> + let build_roots = + List.filter_map + (fun (cmt_scan_item : Yojson.Safe.t) -> + match cmt_scan_item with + | `Assoc cmt_scan_fields -> ( + match List.assoc_opt "build_root" cmt_scan_fields with + | Some (`String build_root) -> Some build_root + | _ -> None) + | _ -> None) + cmt_scan_items + in + Some build_roots + | _ -> None) + | _ -> None + in + build_roots + +let get_build_roots_from_file path = + try + let content = Eio.Path.load path in + Yojson.Safe.from_string content |> get_build_roots_from_json + with _ -> None + +let%expect_test "get_build_roots" = + let print_build_roots result = + match result with + | None -> () + | Some l -> List.iter print_endline l + in + let json_1 = + Yojson.Safe.from_string + {| +{ + "cmt_scan": [ + { + "build_root": "path/to/lib/bs" + } + ] +} + |} + in + + json_1 |> get_build_roots_from_json |> print_build_roots; + [%expect {| path/to/lib/bs |}]; + + let json_2 = + Yojson.Safe.from_string + {| +{ +"cmt_scan": [ + { + "build_root": "path/to/lib/bs" + }, + { + "build_root": "path2/to/lib/bs" + } +] +} + |} + in + + json_2 |> get_build_roots_from_json |> print_build_roots; + [%expect {| + path/to/lib/bs + path2/to/lib/bs + |}]; + + let json_3 = + Yojson.Safe.from_string + {| +{ +"cmt_scan": [ +{ + "build_root": [] +}, +{ + "build_root": {} +} +] +} +|} + in + + json_3 |> get_build_roots_from_json |> print_build_roots; + [%expect {| |}] diff --git a/lsp/src/state.ml b/lsp/src/state.ml index e5e87932119..eb5a202a16f 100644 --- a/lsp/src/state.ml +++ b/lsp/src/state.ml @@ -5,9 +5,29 @@ type status = | Initialized of {params: InitializeParams.t; diagnostics: Diagnostics.t} (* TODO: add trace, configuration *) -type t = {status: status; store: Document_store.t} +type t = {status: status; store: Document_store.t; env: Eio_unix.Stdenv.base} -let create ~store = {status = Uninitialized; store} +let create ~store ~env = {status = Uninitialized; store; env} let initialize t ~params ~diagnostics = {t with status = Initialized {params; diagnostics}} + +let diagnostics t = + match t.status with + | Uninitialized -> assert false + | Initialized init -> init.diagnostics + +(* NOTE: rewrite this? *) +let update_diagnostics diagnostics t = + match t.status with + | Uninitialized -> assert false + | Initialized {params; _} -> + {t with status = Initialized {params; diagnostics}} + +let workspace_root t = + match t.status with + | Uninitialized -> assert false + | Initialized init -> ( + match init.params.rootUri with + | None -> assert false + | Some uri -> uri) diff --git a/rescript-language-server.opam b/rescript-language-server.opam index 6b6aa9366a9..2ed000bacee 100644 --- a/rescript-language-server.opam +++ b/rescript-language-server.opam @@ -13,6 +13,7 @@ depends: [ "eio_main" {>= "1.3"} "analysis" "dune" {>= "3.17"} + "ppx_expect" {with-test & = "0.17.2"} "odoc" {with-doc} ] build: [ diff --git a/tests/lsp_tests/test.ml b/tests/lsp_tests/test.ml index 62319d87d7e..4f92bf9e65c 100644 --- a/tests/lsp_tests/test.ml +++ b/tests/lsp_tests/test.ml @@ -213,11 +213,9 @@ let run_test_for_comment (caret_comment : caret_comment) client = 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 client; let resp = send_request (Client_request.TextDocumentHover @@ -253,6 +251,12 @@ let run_workspace_test ~fs ~workspace_dir client = String_map.iter (fun path comments -> + let hd = comments |> List.hd in + let uri = DocumentUri.of_path hd.path in + let text = hd.text in + + open_document ~uri ~text client; + let filename = Filename.basename path ^ ".expected" in let save_path = workspace_dir // filename in let content = @@ -263,12 +267,25 @@ let run_workspace_test ~fs ~workspace_dir client = Eio.Path.save ~create:(`Or_truncate 0o644) file content) grouped +let client_capabilities = ClientCapabilities.create () + let main () = - Eio_main.run @@ fun env -> - Client.with_server ~env @@ fun client -> let workspace_dir = Sys.getcwd () // "tests" // "lsp_tests" // "basic-workspace" in + Eio_main.run @@ fun env -> + Client.with_server ~env @@ fun client -> + let id = + Client.send_request client + (Client_request.Initialize + (InitializeParams.create ~capabilities:client_capabilities + ~rootUri:(DocumentUri.of_path workspace_dir) + ())) + in + (* Assert than server capabilities return is ok *) + assert ((Client.read_response client id).result |> Result.is_ok); + let () = Client.send_notification client Client_notification.Initialized in + run_workspace_test ~fs:env#fs ~workspace_dir client; Client.stop client |> ignore From 39639c686eba00043ab0c29d5cf39cb8b36733c3 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sat, 6 Jun 2026 13:37:30 -0300 Subject: [PATCH 22/37] Comment to add more compiler log test --- lsp/src/compiler_log.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lsp/src/compiler_log.ml b/lsp/src/compiler_log.ml index dd52872c46e..71f0c6e79c2 100644 --- a/lsp/src/compiler_log.ml +++ b/lsp/src/compiler_log.ml @@ -478,7 +478,7 @@ end = struct build diagnostics @ dependency_cycle_diagnostics end -(* TODO: Add more tests (fatal error), gentype warning, configured as error *) +(* TODO: Add more tests (fatal error), gentype warning, configured as error, The implementation `does not match the interface *) let%expect_test "parse log" = let print_logs logs = logs From 5e002cb8877ea27149456d577591c84f40ba071d Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sat, 6 Jun 2026 13:41:12 -0300 Subject: [PATCH 23/37] ci: add lsp test step --- .github/workflows/ci.yml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 4c09b1d6b5e..3687d48b0ca 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -377,6 +377,9 @@ jobs: if: runner.os != 'Windows' run: make -C tests/gentype_tests/typescript-react-example clean test + - name: Run LSP tests + run: make test-lsp + # On Windows, after running setup-ocaml (if it wasn't cached yet or the cache couldn't be restored), # Cygwin bash is used instead of Git Bash for Windows, breaking the rewatch tests. # So we need to adjust the path to bring back Git Bash for Windows. @@ -655,7 +658,7 @@ jobs: uses: actions/checkout@v6 - name: Run make in dev container uses: devcontainers/ci@v0.3 - with: + with: push: never runCmd: make From 5781622f5f6bed2f113dc659d62d5f231b08b856 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sat, 6 Jun 2026 13:51:14 -0300 Subject: [PATCH 24/37] fix opam install ppx_expect `ppx_expect` uses Jane Street-style opam versions like `v0.17.2`, not `0.17.2` --- dune-project | 2 +- rescript-language-server.opam | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/dune-project b/dune-project index 7a100fc98f5..dcbbbeaa9ec 100644 --- a/dune-project +++ b/dune-project @@ -91,4 +91,4 @@ analysis dune (ppx_expect - (and :with-test (= 0.17.2))))) + (and :with-test (= v0.17.2))))) diff --git a/rescript-language-server.opam b/rescript-language-server.opam index 2ed000bacee..42640efe115 100644 --- a/rescript-language-server.opam +++ b/rescript-language-server.opam @@ -13,7 +13,7 @@ depends: [ "eio_main" {>= "1.3"} "analysis" "dune" {>= "3.17"} - "ppx_expect" {with-test & = "0.17.2"} + "ppx_expect" {with-test & = "v0.17.2"} "odoc" {with-doc} ] build: [ From 728c4bff63dc2c41a7c8317b677e87e23a19aace Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sat, 6 Jun 2026 14:12:11 -0300 Subject: [PATCH 25/37] ci: run test inside opam `opam exec --` --- .github/workflows/ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 3687d48b0ca..5e46e12aea9 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -378,7 +378,7 @@ jobs: run: make -C tests/gentype_tests/typescript-react-example clean test - name: Run LSP tests - run: make test-lsp + run: opam exec -- make test-lsp # On Windows, after running setup-ocaml (if it wasn't cached yet or the cache couldn't be restored), # Cygwin bash is used instead of Git Bash for Windows, breaking the rewatch tests. From 33edc8539ec290d302062d194f1bc980ce5c6ee6 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sat, 6 Jun 2026 14:27:15 -0300 Subject: [PATCH 26/37] lsp: disable hover supports_markdown_links for now --- lsp/src/hover.ml | 2 +- .../basic-workspace/Hover.res.expected | 22 +++++++++---------- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/lsp/src/hover.ml b/lsp/src/hover.ml index 98a40a5aefd..f5229e41f07 100644 --- a/lsp/src/hover.ml +++ b/lsp/src/hover.ml @@ -3,7 +3,7 @@ open Lsp.Types let create ~(position : Position.t) ~(uri : DocumentUri.t) (server : State.t Server.t) = (* TODO: should be a config *) - let supports_markdown_links = true in + let supports_markdown_links = false in let source = (Document_store.get_document ~uri server.state.store).text in let full = diff --git a/tests/lsp_tests/basic-workspace/Hover.res.expected b/tests/lsp_tests/basic-workspace/Hover.res.expected index e5a6f734da4..4baaf2e0253 100644 --- a/tests/lsp_tests/basic-workspace/Hover.res.expected +++ b/tests/lsp_tests/basic-workspace/Hover.res.expected @@ -131,7 +131,7 @@ 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" + "value": "```rescript\nAA.cond<([< #str(string)] as 'a)> => AA.cond<'a>\n```\n\n---\n```rescript\ntype AA.cond<'a> = 'a\n constraint 'a = [< #str(string)]\n```\n" } } @@ -140,7 +140,7 @@ 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" + "value": "```rescript\nAA.cond<([< #str(string)] as 'a)> => AA.cond<'a>\n```\n\n---\n```rescript\ntype AA.cond<'a> = 'a\n constraint 'a = [< #str(string)]\n```\n" } } @@ -203,7 +203,7 @@ 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" + "value": "```rescript\nfoo\n```\n\n---\n```rescript\ntype foo<'a> = {content: 'a, zzz: string}\n```\n\n\n---\n```rescript\ntype bar = {age: int}\n```\n" } } @@ -212,7 +212,7 @@ 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" + "value": "```rescript\nfoobar\n```\n\n---\n```rescript\ntype foobar = foo\n```\n" } } @@ -229,7 +229,7 @@ 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" + "value": "```rescript\nCompV4.props => React.element\n```\n\n---\n```rescript\ntype CompV4.props<'n, 's> = {n?: 'n, s: 's}\n```\n\n\n---\n```rescript\ntype React.element = Jsx.element\n```\n" } } @@ -238,7 +238,7 @@ 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" + "value": "```rescript\nuseR\n```\n\n---\n```rescript\ntype useR = {x: int, y: list>>}\n```\n\n\n---\n```rescript\ntype r<'a> = {i: 'a, f: float}\n```\n" } } @@ -282,7 +282,7 @@ 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" + "value": "```rescript\nvariant\nCoolVariant\n```\n---\n Cool variant! \n\n---\n```rescript\ntype variant = CoolVariant | OtherCoolVariant\n```\n" } } @@ -291,7 +291,7 @@ 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" + "value": "```rescript\npayloadVariants\nInlineRecord({field1: int, field2: bool})\n```\n\n---\n```rescript\ntype payloadVariants =\n | InlineRecord({field1: int, field2: bool})\n | Args(int, bool)\n```\n" } } @@ -300,7 +300,7 @@ 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" + "value": "```rescript\npayloadVariants\nArgs(int, bool)\n```\n\n---\n```rescript\ntype payloadVariants =\n | InlineRecord({field1: int, field2: bool})\n | Args(int, bool)\n```\n" } } @@ -309,7 +309,7 @@ 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" + "value": "```rescript\nRecursiveVariants.t\nAction1(int)\n```\n\n---\n```rescript\ntype RecursiveVariants.t =\n | Action1(int)\n | Action2(float)\n | Batch(array)\n```\n" } } @@ -335,7 +335,7 @@ 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" + "value": "```rescript\ntype aliased = variant\n```\n\n---\n```rescript\ntype variant = CoolVariant | OtherCoolVariant\n```\n" } } From 75a61238a10b0e79bff96e3d6795ec3544b25506 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sat, 6 Jun 2026 15:05:38 -0300 Subject: [PATCH 27/37] Move Eio_main setup to LSP executable Keep the language server library independent from Eio_main by exposing a listen function that accepts input, output, and filesystem handles. Store only the filesystem handle in LSP state and remove the unused environment from the server record. --- lsp/bin/dune | 2 +- lsp/bin/main.ml | 7 ++++++- lsp/src/compiler.ml | 4 ++-- lsp/src/dune | 2 +- lsp/src/rescript_language_server.ml | 8 +++----- lsp/src/server.ml | 13 ++++--------- lsp/src/state.ml | 4 ++-- tests/lsp_tests/dune | 2 +- 8 files changed, 20 insertions(+), 22 deletions(-) diff --git a/lsp/bin/dune b/lsp/bin/dune index ecd09b26ec7..5ff2a68c37b 100644 --- a/lsp/bin/dune +++ b/lsp/bin/dune @@ -2,4 +2,4 @@ (name main) (package rescript-language-server) (public_name rescript-language-server) - (libraries rescript_language_server)) + (libraries rescript_language_server eio_main)) diff --git a/lsp/bin/main.ml b/lsp/bin/main.ml index 73ed8920da0..ff07d3a8375 100644 --- a/lsp/bin/main.ml +++ b/lsp/bin/main.ml @@ -1 +1,6 @@ -let () = Rescript_language_server.main () +let () = + Eio_main.run (fun env -> + let fs = Eio.Stdenv.fs env in + let stdin = Eio.Stdenv.stdin env in + let stdout = Eio.Stdenv.stdout env in + Rescript_language_server.listen ~input:stdin ~output:stdout ~fs) diff --git a/lsp/src/compiler.ml b/lsp/src/compiler.ml index 597d6d41ee1..b99b502cf32 100644 --- a/lsp/src/compiler.ml +++ b/lsp/src/compiler.ml @@ -13,7 +13,7 @@ let collect_diagnostics_from_log_using_source_dirs workspace_root // Constants.sources_dirs in let build_roots = - Source_dirs.get_build_roots_from_file Eio.Path.(state.env#fs / path) + Source_dirs.get_build_roots_from_file Eio.Path.(state.fs / path) in let diagnostics = match build_roots with @@ -24,7 +24,7 @@ let collect_diagnostics_from_log_using_source_dirs workspace_root workspace_root_path // build_root // Constants.compiler_log in collect_diagnostics_from_log_file - Eio.Path.(state.env#fs / compiler_log_path)) + Eio.Path.(state.fs / compiler_log_path)) |> List.flatten | None -> [] in diff --git a/lsp/src/dune b/lsp/src/dune index 17b08c9203a..c2c9490f6b1 100644 --- a/lsp/src/dune +++ b/lsp/src/dune @@ -1,6 +1,6 @@ (library (name rescript_language_server) - (libraries lsp eio eio_main analysis) + (libraries lsp eio analysis) (inline_tests) (preprocess (pps ppx_expect))) diff --git a/lsp/src/rescript_language_server.ml b/lsp/src/rescript_language_server.ml index 840117b024c..ce88d7fd860 100644 --- a/lsp/src/rescript_language_server.ml +++ b/lsp/src/rescript_language_server.ml @@ -120,8 +120,6 @@ let on_notification notification (server : State.t Server.t) = | Exit -> state | _ -> state -let main () = - Eio_main.run (fun env -> - let state = State.create ~store:(Document_store.create ()) ~env in - Server.listen ~input:env#stdin ~output:env#stdout ~on_request - ~on_notification ~state ~env) +let listen ~input ~output ~fs = + let state = State.create ~store:(Document_store.create ()) ~fs in + Server.listen ~input ~output ~on_request ~on_notification ~state diff --git a/lsp/src/server.ml b/lsp/src/server.ml index 6a4262a826f..2f8dec12891 100644 --- a/lsp/src/server.ml +++ b/lsp/src/server.ml @@ -113,12 +113,7 @@ type request_context = { pending: pending_request Request_id_table.t; } -type 'a t = { - channel: Chan.output; - env: Eio_unix.Stdenv.base; - state: 'a; - request_context: request_context; -} +type 'a t = {channel: Chan.output; state: 'a; request_context: request_context} let state t = t.state @@ -172,7 +167,7 @@ let rec input_loop ~input ~state with_ = | exception _ -> raise (Failure "Server.input_loop") | None -> () -let listen ~input ~output ~on_request ~on_notification ~state ~env = +let listen ~input ~output ~on_request ~on_notification ~state = let handle_request server request = let response, state = match Lsp.Client_request.of_jsonrpc request with @@ -196,14 +191,14 @@ let listen ~input ~output ~on_request ~on_notification ~state ~env = {next_id = 1; pending = Request_id_table.create 16} in input_loop ~input ~state (fun state packet -> - let server = {channel; state; env; request_context} in + let server = {channel; state; request_context} in match packet with | Notification notification -> handle_notification server notification | Request request -> handle_request server request | Batch_call calls -> List.fold_left (fun state call -> - let server = {channel; state; env; request_context} in + let server = {channel; state; request_context} in match call with | `Request request -> handle_request server request | `Notification notification -> diff --git a/lsp/src/state.ml b/lsp/src/state.ml index eb5a202a16f..d5b1a3094aa 100644 --- a/lsp/src/state.ml +++ b/lsp/src/state.ml @@ -5,9 +5,9 @@ type status = | Initialized of {params: InitializeParams.t; diagnostics: Diagnostics.t} (* TODO: add trace, configuration *) -type t = {status: status; store: Document_store.t; env: Eio_unix.Stdenv.base} +type t = {status: status; store: Document_store.t; fs: Eio.Fs.dir_ty Eio.Path.t} -let create ~store ~env = {status = Uninitialized; store; env} +let create ~store ~fs = {status = Uninitialized; store; fs} let initialize t ~params ~diagnostics = {t with status = Initialized {params; diagnostics}} diff --git a/tests/lsp_tests/dune b/tests/lsp_tests/dune index fd9baef10d0..b9f23ca8eec 100644 --- a/tests/lsp_tests/dune +++ b/tests/lsp_tests/dune @@ -2,7 +2,7 @@ (name test) (package rescript-language-server) (public_name lsp-tests) - (libraries lsp jsonrpc yojson eio eio_main eio.unix) + (libraries lsp jsonrpc yojson eio eio_main) (flags (-w "-9-32-33"))) From 126f67ad5c70ed589a4ce8072d391776001aae32 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sat, 6 Jun 2026 15:21:46 -0300 Subject: [PATCH 28/37] ci: skip lsp tests on Windows --- .github/workflows/ci.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 5e46e12aea9..26d60bddccf 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -377,7 +377,10 @@ jobs: if: runner.os != 'Windows' run: make -C tests/gentype_tests/typescript-react-example clean test + # Skip tests on Windows because OCaml Eio process operations is not supported on Windows yet + # Eio.Stdenv.process_mgr raise a error, see https://github.com/ocaml-multicore/eio/blob/37d6e67f7e25b43e4a66574ed98838c79f1a21b4/lib_eio_windows/eio_windows.ml#L36 - name: Run LSP tests + if: runner.os != 'Windows' run: opam exec -- make test-lsp # On Windows, after running setup-ocaml (if it wasn't cached yet or the cache couldn't be restored), From 5d14a575f6a471af7dc49f41ed3dea3d81dc684a Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sun, 7 Jun 2026 00:50:44 -0300 Subject: [PATCH 29/37] Expand LSP request handling and diagnostics Advertise and implement the main language server capabilities using the existing analysis commands, including completion, signature help, definition, references, document symbols, code actions, code lenses, inlay hints, semantic tokens, rename, and formatting. Rework diagnostics so compiler log diagnostics are treated as build snapshots, stale entries are cleared, and syntax diagnostics from the current in-memory document are appended on change. Also make document symbols source-based so the LSP can serve open documents without reading from disk. --- analysis/bin/main.ml | 2 +- analysis/src/cli.ml | 11 +- analysis/src/document_symbol.ml | 20 +- lsp/src/compiler.ml | 8 +- lsp/src/compiler_log.ml | 33 ++- lsp/src/diagnostics.ml | 116 ++++++++--- lsp/src/document_store.ml | 12 +- lsp/src/dune | 4 +- lsp/src/hover.ml | 15 -- lsp/src/rescript_language_server.ml | 307 +++++++++++++++++++++++++--- lsp/src/server.ml | 2 +- tests/lsp_tests/test.ml | 1 + 12 files changed, 421 insertions(+), 110 deletions(-) delete mode 100644 lsp/src/hover.ml diff --git a/analysis/bin/main.ml b/analysis/bin/main.ml index cbb0db068e5..f57103378be 100644 --- a/analysis/bin/main.ml +++ b/analysis/bin/main.ml @@ -145,7 +145,7 @@ let main () = Cli.type_definition ~path ~pos:(int_of_string line, int_of_string col) ~debug - | [_; "documentSymbol"; path] -> Document_symbol.command ~path + | [_; "documentSymbol"; path] -> Cli.document_symbol ~path | [_; "hover"; path; line; col; current_file; supports_markdown_links] -> Cli.hover ~path ~pos:(int_of_string line, int_of_string col) diff --git a/analysis/src/cli.ml b/analysis/src/cli.ml index 4277934fc7e..78d6c86a5f8 100644 --- a/analysis/src/cli.ml +++ b/analysis/src/cli.ml @@ -159,6 +159,15 @@ let semantic_tokens ~path = let tokens = Semantic_tokens.semantic_tokens ~source ~kind_file in Lsp.Types.SemanticTokens.yojson_of_t tokens |> print_string +let document_symbol ~path = + match Files.read_file path with + | None -> print_null () + | Some source -> + let kind_file = Files.classify_source_file path in + Document_symbol.get_symbols ~source ~kind_file + |> List.map Lsp.Types.DocumentSymbol.yojson_of_t + |> print_list + let test ~path = Uri.strip_path := true; match Files.read_file path with @@ -245,7 +254,7 @@ let test ~path = Dce_command.command () | "doc" -> print_endline ("DocumentSymbol " ^ path); - Document_symbol.command ~path + document_symbol ~path | "hig" -> print_endline ("Highlight " ^ path); let source = Files.read_file path |> Option.get in diff --git a/analysis/src/document_symbol.ml b/analysis/src/document_symbol.ml index 49ae7b32d73..5fec0db5d78 100644 --- a/analysis/src/document_symbol.ml +++ b/analysis/src/document_symbol.ml @@ -1,6 +1,6 @@ (* https://microsoft.github.io/language-server-protocol/specifications/specification-current/#textDocument_documentSymbol *) -let command ~path = +let get_symbols ~source ~kind_file = let symbols = ref [] in let add_symbol name loc kind = if @@ -115,17 +115,18 @@ let command ~path = } in - (if Filename.check_suffix path ".res" then + (if kind_file = Files.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 = structure} = parser ~filename:path in + let {Res_driver.parsetree = structure} = parser ~source in iterator.structure iterator structure |> ignore else let parser = - Res_driver.parsing_engine.parse_interface ~for_printer:false + Res_driver.parsing_engine.parse_interface_from_source ~for_printer:false in - let {Res_driver.parsetree = signature} = parser ~filename:path in + let {Res_driver.parsetree = signature} = parser ~source in iterator.signature iterator signature |> ignore); let is_inside ({ @@ -182,9 +183,4 @@ let command ~path = |> add_sorted_symbols_to_children ~sorted_symbols:rest in let sorted_symbols = !symbols |> List.sort compare_symbol in - let symbols_with_children = - [] |> add_sorted_symbols_to_children ~sorted_symbols - in - `List (symbols_with_children |> List.map Lsp.Types.DocumentSymbol.yojson_of_t) - |> Yojson.Safe.pretty_to_string ~std:true - |> print_endline + [] |> add_sorted_symbols_to_children ~sorted_symbols diff --git a/lsp/src/compiler.ml b/lsp/src/compiler.ml index b99b502cf32..95293e37595 100644 --- a/lsp/src/compiler.ml +++ b/lsp/src/compiler.ml @@ -7,14 +7,13 @@ let collect_diagnostics_from_log_file path = let collect_diagnostics_from_log_using_source_dirs workspace_root (state : State.t) = let ( // ) = Filename.concat in + let ( /// ) = Eio.Path.( / ) in let workspace_root_path = workspace_root |> Lsp.Types.DocumentUri.to_path in let path = workspace_root_path // Constants.compiler_dir_partial_path // Constants.sources_dirs in - let build_roots = - Source_dirs.get_build_roots_from_file Eio.Path.(state.fs / path) - in + let build_roots = Source_dirs.get_build_roots_from_file (state.fs /// path) in let diagnostics = match build_roots with | Some build_roots -> @@ -23,8 +22,7 @@ let collect_diagnostics_from_log_using_source_dirs workspace_root let compiler_log_path = workspace_root_path // build_root // Constants.compiler_log in - collect_diagnostics_from_log_file - Eio.Path.(state.fs / compiler_log_path)) + collect_diagnostics_from_log_file (state.fs /// compiler_log_path)) |> List.flatten | None -> [] in diff --git a/lsp/src/compiler_log.ml b/lsp/src/compiler_log.ml index 71f0c6e79c2..fcf312c222e 100644 --- a/lsp/src/compiler_log.ml +++ b/lsp/src/compiler_log.ml @@ -1,31 +1,31 @@ module Parse : sig - type filepath = Relative_path of string | Full_path of string + type path = Relative_path of string | Full_path of string - type error = + type entry = | Syntax_error | Warning | Common_error (* type error, value can't be found *) | Circular_dependency | Unknow - type diagnostic_entry = {error: error; diagnostic: Lsp.Types.Diagnostic.t} + type diagnostic_entry = {entry: entry; diagnostic: Lsp.Types.Diagnostic.t} - val parse_log_content : string -> (filepath * diagnostic_entry) list + val parse_log_content : string -> (path * diagnostic_entry) list end = struct type position = {line: int; col: int} type range = {start_pos: position; end_pos: position} - type filepath = Relative_path of string | Full_path of string + type path = Relative_path of string | Full_path of string - type error = + type entry = | Syntax_error | Warning | Common_error | Circular_dependency | Unknow - type diagnostic_entry = {error: error; diagnostic: Lsp.Types.Diagnostic.t} + type diagnostic_entry = {entry: entry; diagnostic: Lsp.Types.Diagnostic.t} type location_format = Path_location | File_location @@ -453,7 +453,7 @@ end = struct | None -> None) in - let error = + let entry = match location_format with | File_location -> kind_from_message raw_message_lines | Path_location -> ( @@ -465,14 +465,14 @@ end = struct let message = message_from_lines raw_message_lines in let diagnostic = make_diagnostic ?severity ~range ~message () in - (filepath, {error; diagnostic}) :: build rest + (filepath, {entry; diagnostic}) :: build rest in let dependency_cycle_diagnostics = parse_dependency_cycle_entries lines len - |> List.map (fun (filepath, error, range, severity, message) -> + |> List.map (fun (filepath, entry, range, severity, message) -> let diagnostic = make_diagnostic ~severity ~range ~message () in - (filepath, {error; diagnostic})) + (filepath, {entry; diagnostic})) in build diagnostics @ dependency_cycle_diagnostics @@ -482,21 +482,20 @@ end let%expect_test "parse log" = let print_logs logs = logs - |> List.iter - (fun ((filepath : Parse.filepath), (entry : Parse.diagnostic_entry)) -> - let filepath = - match filepath with + |> List.iter (fun ((path : Parse.path), (entry : Parse.diagnostic_entry)) -> + let path = + match path with | Parse.Relative_path p -> Printf.sprintf "Relative_path(%s)" p | Full_path p -> Printf.sprintf "Full_path(%s)" p in print_endline - ((match entry.error with + ((match entry.entry with | Syntax_error -> "Syntax_error" | Warning -> "Warning" | Unknow -> "Unknow" | Circular_dependency -> "Circular_dependency" | Common_error -> "Common_error") - ^ " - " ^ filepath); + ^ " - " ^ path); Lsp.Types.Diagnostic.yojson_of_t entry.diagnostic |> Yojson.Safe.pretty_to_string |> print_endline; print_newline ()) diff --git a/lsp/src/diagnostics.ml b/lsp/src/diagnostics.ml index 788c6b69ee4..b9ebb968088 100644 --- a/lsp/src/diagnostics.ml +++ b/lsp/src/diagnostics.ml @@ -1,13 +1,24 @@ -module Uri_map = Map.Make (Lsp.Uri) +open Lsp +open Lsp.Types + +module Uri_map = Map.Make (Uri) type t = { - diagnostics: Lsp.Types.Diagnostic.t list Uri_map.t; - send: Lsp.Types.PublishDiagnosticsParams.t list -> unit; + diagnostics: Diagnostic.t list Uri_map.t; + send: PublishDiagnosticsParams.t -> unit; } let create ~diagnostics ~send = {diagnostics; send} -let set ~(diagnostics : Lsp.Types.Diagnostic.t list Uri_map.t) t = +let from_uri ~uri (d : Diagnostic.t list) = + let map = Uri_map.empty in + Uri_map.add uri d map + +(* Compiler log diagnostics are a full snapshot of the latest build output. + Overwrite the previous compiler log diagnostics so files that disappeared + from the new log receive an empty diagnostic list and stale errors are + cleared in the client. *) +let overwrite ~(new_diagnostics : Diagnostic.t list Uri_map.t) t = let diagnostics = Uri_map.merge (fun _ existing incoming -> @@ -16,35 +27,92 @@ let set ~(diagnostics : Lsp.Types.Diagnostic.t list Uri_map.t) t = | Some _, None -> Some [] | None, Some diagnostics -> Some diagnostics | Some _, Some diagnostics -> Some diagnostics) - t.diagnostics diagnostics + t.diagnostics new_diagnostics + in + {t with diagnostics} + +let append ~(new_diagnostics : Diagnostic.t list Uri_map.t) t = + let diagnostics = + Uri_map.merge + (fun _ existing incoming -> + match (existing, incoming) with + | None, None -> Some [] + | Some diagnostics, None -> Some diagnostics + | None, Some diagnostics -> Some diagnostics + | Some a, Some b -> Some (a @ b)) + t.diagnostics new_diagnostics in {t with diagnostics} let send t = Uri_map.iter (fun uri diagnostics -> - t.send [Lsp.Types.PublishDiagnosticsParams.create ~uri ~diagnostics ()]) + t.send (PublishDiagnosticsParams.create ~uri ~diagnostics ())) t.diagnostics -let convert_to_lsp (workspace_root : Lsp.Types.DocumentUri.t) diagnostics = - let workspace_root_path = workspace_root |> Lsp.Types.DocumentUri.to_path in - diagnostics +(* Convert parsed compiler-log entries into LSP diagnostics grouped by document URI. + Compiler logs may report paths either relative to the workspace root or as + absolute paths, so this function normalizes each entry into a DocumentUri + before publishing. + Syntax errors are skipped here because they are produced from the current + in-memory document text during TextDocumentDidChange notification. + Compiler log diagnostics are used for build output such as type errors, + warnings, and circular dependencies. *) +let to_lsp_format (workspace_root : DocumentUri.t) + (doc_store : Document_store.t) diagnostics = + let workspace_root_path = workspace_root |> DocumentUri.to_path in + + let diagnostics_sanitized = + diagnostics + |> List.filter_map + (fun + (filepath, (diagnostic_entry : Compiler_log.Parse.diagnostic_entry)) + -> + let uri = + match filepath with + | Compiler_log.Parse.Relative_path p -> + DocumentUri.of_path (Filename.concat workspace_root_path p) + | Full_path p -> DocumentUri.of_path p + in + + match diagnostic_entry.entry with + | Syntax_error -> None + | Circular_dependency -> + (* Circular dependency diagnostics are special-cased because the compiler log + does not point at a precise source range. When the document is open, we expand + the diagnostic range to cover the whole document so the editor can display a + file-level diagnostic. If the document is not open, we keep the range parsed + from the compiler log [(0,0), (0,0)].*) + let range = + match Document_store.get_opt ~uri doc_store with + | None -> diagnostic_entry.diagnostic.range + | Some {text} -> + let lines = String.split_on_char '\n' text in + + let end_line, end_character = + match List.rev lines with + | [] -> (0, 0) + | last_line :: rest -> + let line_count = List.length rest in + (line_count - 1, String.length last_line - 1) + in + Range.create + ~start:(Position.create ~line:0 ~character:0) + ~end_: + (Position.create ~line:end_line ~character:end_character) + in + let diagnostic = {diagnostic_entry.diagnostic with range} in + Some (uri, diagnostic) + | Warning | Common_error | Unknow -> + Some (uri, diagnostic_entry.diagnostic)) + in + + diagnostics_sanitized |> List.fold_left - (fun acc - (filepath, (diagnostic_entry : Compiler_log.Parse.diagnostic_entry)) - -> - let document_uri = - match filepath with - | Compiler_log.Parse.Relative_path p -> - Lsp.Types.DocumentUri.of_path - (Filename.concat workspace_root_path p) - | Full_path p -> Lsp.Types.DocumentUri.of_path p - in - - Uri_map.update document_uri + (fun acc (uri, diagnostic) -> + Uri_map.update uri (function - | None -> Some [diagnostic_entry.diagnostic] - | Some diagnostics -> - Some (diagnostic_entry.diagnostic :: diagnostics)) + | None -> Some [diagnostic] + | Some diagnostics -> Some (diagnostic :: diagnostics)) acc) Uri_map.empty diff --git a/lsp/src/document_store.ml b/lsp/src/document_store.ml index 1ee3c141d20..68badd7979d 100644 --- a/lsp/src/document_store.ml +++ b/lsp/src/document_store.ml @@ -8,7 +8,7 @@ let raise ~message = Jsonrpc.Response.Error.raise (Jsonrpc.Response.Error.make ~code:InternalError ~message ()) -let open_document t ~uri ~text ~version = +let add t ~uri ~text ~version = (match Hashtbl.mem t.documents uri with | false -> Hashtbl.add t.documents uri {text; version} | true -> @@ -18,7 +18,7 @@ let open_document t ~uri ~text ~version = (Lsp.Uri.to_string uri))); t -let update_document t ~uri ~text ~version = +let update t ~uri ~text ~version = (match Hashtbl.find_opt t.documents uri with | None -> raise @@ -28,7 +28,7 @@ let update_document t ~uri ~text ~version = | Some _ -> Hashtbl.replace t.documents uri {text; version}); t -let remove_document t ~uri = +let remove t ~uri = (match Hashtbl.mem t.documents uri with | true -> Hashtbl.remove t.documents uri | false -> @@ -38,8 +38,10 @@ let remove_document t ~uri = (Lsp.Uri.to_string uri))); t -let get_document t ~uri = - match Hashtbl.find_opt t.documents uri with +let get_opt t ~uri = Hashtbl.find_opt t.documents uri + +let get t ~uri = + match get_opt t ~uri with | Some doc -> doc | None -> raise diff --git a/lsp/src/dune b/lsp/src/dune index c2c9490f6b1..ca1d9b5639a 100644 --- a/lsp/src/dune +++ b/lsp/src/dune @@ -3,4 +3,6 @@ (libraries lsp eio analysis) (inline_tests) (preprocess - (pps ppx_expect))) + (pps ppx_expect)) + (flags + (:standard -w +a-4-9-30-40-41-42-48-70))) diff --git a/lsp/src/hover.ml b/lsp/src/hover.ml deleted file mode 100644 index f5229e41f07..00000000000 --- a/lsp/src/hover.ml +++ /dev/null @@ -1,15 +0,0 @@ -open Lsp.Types - -let create ~(position : Position.t) ~(uri : DocumentUri.t) - (server : State.t Server.t) = - (* TODO: should be a config *) - let supports_markdown_links = false in - - let source = (Document_store.get_document ~uri server.state.store).text in - let full = - Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) - in - - Analysis.Commands.hover ~source ~kind_file:(Document.kind uri) - ~pos:(position.line, position.character) - ~debug:false ~supports_markdown_links ~full diff --git a/lsp/src/rescript_language_server.ml b/lsp/src/rescript_language_server.ml index ce88d7fd860..38aef8a7c53 100644 --- a/lsp/src/rescript_language_server.ml +++ b/lsp/src/rescript_language_server.ml @@ -1,5 +1,7 @@ -let initialization (_client_capabilities : Lsp.Types.ClientCapabilities.t) = - let open Lsp.Types in +open Lsp +open Types + +let initialization (_client_capabilities : ClientCapabilities.t) = let textDocumentSync = `TextDocumentSyncOptions (TextDocumentSyncOptions.create ~openClose:true @@ -7,8 +9,60 @@ let initialization (_client_capabilities : Lsp.Types.ClientCapabilities.t) = ~save:(`SaveOptions (SaveOptions.create ~includeText:false ())) ~willSaveWaitUntil:false ()) in + let completionProvider = + CompletionOptions.create + ~triggerCharacters:["."; ">"; "@"; "~"; "\""; "="; "("] + ~resolveProvider:true () + in + let codeLensProvider = CodeLensOptions.create ~resolveProvider:false () in + let signatureHelpProvider = + SignatureHelpOptions.create ~triggerCharacters:["("] + ~retriggerCharacters:["="; ","] () + in + let inlayHintProvider = + `InlayHintOptions (InlayHintOptions.create ~resolveProvider:false ()) + in + let renameProvider = + `RenameOptions (RenameOptions.create ~prepareProvider:true ()) + in + let workspace = + let workspaceFolders = + WorkspaceFoldersServerCapabilities.create ~supported:true + ~changeNotifications:(`Bool true) () + in + ServerCapabilities.create_workspace ~workspaceFolders () + in + let semanticTokensProvider = + let legend = + SemanticTokensLegend.create ~tokenModifiers:[] + ~tokenTypes: + [ + "operator"; + "variable"; + "type"; + (* emit jsx-tag < and > in
as modifier *) + "modifier"; + "namespace"; + "enumMember"; + "property"; + (* emit jsxlowercase, div in
as interface *) + "interface"; + ] + in + let full = `Full (SemanticTokensOptions.create_full ~delta:false ()) in + `SemanticTokensOptions (SemanticTokensOptions.create ~legend ~full ()) + in + let codeActionProvider = + `CodeActionOptions (CodeActionOptions.create ~resolveProvider:false ()) + in let capabilities = - ServerCapabilities.create ~textDocumentSync ~hoverProvider:(`Bool true) () + ServerCapabilities.create ~textDocumentSync ~completionProvider + ~codeLensProvider ~hoverProvider:(`Bool true) ~signatureHelpProvider + ~renameProvider ~workspace ~semanticTokensProvider ~inlayHintProvider + ~definitionProvider:(`Bool true) ~typeDefinitionProvider:(`Bool true) + ~codeActionProvider ~documentSymbolProvider:(`Bool true) + ~referencesProvider:(`Bool true) ~documentFormattingProvider:(`Bool true) + () in let serverInfo = let version = "2.0.0-aplha.1" in @@ -17,41 +71,222 @@ let initialization (_client_capabilities : Lsp.Types.ClientCapabilities.t) = in InitializeResult.create ~capabilities ~serverInfo () -let get_updated_diagnostics (state : State.t) = +let get_updated_diagnostics_from_log (state : State.t) = let workspace_root = State.workspace_root state in let diagnostics = Compiler.collect_diagnostics_from_log_using_source_dirs workspace_root state - |> Diagnostics.convert_to_lsp workspace_root + |> Diagnostics.to_lsp_format workspace_root state.store in - Diagnostics.set ~diagnostics (State.diagnostics state) + Diagnostics.overwrite ~new_diagnostics:diagnostics (State.diagnostics state) -let on_initialize (params : Lsp.Types.InitializeParams.t) - (server : State.t Server.t) = +let on_initialize (params : InitializeParams.t) (server : State.t Server.t) = let state = Server.state server in let diagnostics = Diagnostics.create ~diagnostics:Diagnostics.Uri_map.empty - ~send:(fun publish_diagnostics -> - publish_diagnostics - |> List.iter (fun publish_diagnostic_params -> - Server.notification - (Lsp.Server_notification.PublishDiagnostics - publish_diagnostic_params) server)) + ~send:(fun publish_diagnostics_params -> + Server.notification + (Server_notification.PublishDiagnostics publish_diagnostics_params) + server) in let state = State.initialize state ~params ~diagnostics in let initialization_info = initialization params.capabilities in (initialization_info, state) -let on_request (Lsp.Client_request.E request) (server : State.t Server.t) = +let on_request (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 + let ok value = Ok (Client_request.yojson_of_result request value) in + match request with - | Lsp.Client_request.Initialize params -> + | Client_request.Initialize params -> let initialization_info, state = on_initialize params server in (ok initialization_info, state) | Shutdown -> (ok (), state) - | TextDocumentHover {position; textDocument = {uri}; _} -> - (ok (Hover.create ~position ~uri server), state) + | TextDocumentHover {position; textDocument = {uri}} -> + let source = (Document_store.get ~uri state.store).text in + let full = + Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) + in + let hover = + Analysis.Commands.hover ~source ~kind_file:(Document.kind uri) + ~pos:(position.line, position.character) + ~debug:false + (* TODO: supports_markdown_links should be get from client capabilities *) + ~supports_markdown_links:false ~full + in + (ok hover, state) + | TextDocumentCompletion {textDocument = {uri}; position} -> + let source = (Document_store.get ~uri state.store).text in + let full = + Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) + in + let comp = + Analysis.Commands.completion ~debug:false ~source + ~kind_file:(Document.kind uri) + ~pos:(position.line, position.character) + ~full + in + (ok (Some (`List comp)), state) + | CompletionItemResolve item -> + let resp = + match (item.documentation, item.data) with + (* documentation === null && item.data != null (https://github.com/rescript-lang/rescript-vscode/blob/2bc69d29ed92e19b14054952bafe9d4af7bd4c4b/server/src/server.ts#L958-L970) + *) + | None, Some (`Assoc _) -> ( + match item.data with + | Some (`Assoc fields) -> ( + let file_path = List.assoc_opt "filePath" fields in + let module_path = List.assoc_opt "modulePath" fields in + match (file_path, module_path) with + | Some (`String file_path), Some (`String module_path) -> + let full = Analysis.Cmt.load_full_cmt_from_path ~path:file_path in + let documentation = + Analysis.Commands.completion_resolve ~full ~module_path + in + Some {item with documentation} + | _ -> None) + | _ -> None) + | _ -> None + in + (ok (resp |> Option.value ~default:item), state) + | SignatureHelp {textDocument = {uri}; position} -> + let source = (Document_store.get ~uri state.store).text in + let full = + Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) + in + let resp = + match + Analysis.Commands.signature_help ~source ~kind_file:(Document.kind uri) + ~pos:(position.line, position.character) + ~full ~allow_for_constructor_payloads:true ~debug:false + with + | Some s -> s + | None -> SignatureHelp.create ~signatures:[] () + in + (ok resp, state) + | TextDocumentDefinition {textDocument = {uri}; position} -> + let full = + Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) + in + let resp = + match + Analysis.Commands.definition ~full + ~pos:(position.line, position.character) + ~debug:false + with + | Some loc -> Some (`Location [loc]) + | None -> None + in + (ok resp, state) + | TextDocumentTypeDefinition {textDocument = {uri}; position} -> + let full = + Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) + in + let resp = + match + Analysis.Commands.type_definition ~full + ~pos:(position.line, position.character) + ~debug:false + with + | Some loc -> Some (`Location [loc]) + | None -> None + in + (ok resp, state) + | TextDocumentReferences {textDocument = {uri}; position} -> + let full = + Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) + in + let resp = + Analysis.Commands.references ~full + ~pos:(position.line, position.character) + ~debug:false + in + (ok (Some resp), state) + | DocumentSymbol {textDocument = {uri}} -> ( + (* NOTE: Client side bug. For some reason, Neovim requests the document symbol before sending the TextDocumentDidOpen notification. *) + match Document_store.get_opt ~uri state.store with + | None -> (ok None, state) + | Some {text} -> + let resp = + Analysis.Document_symbol.get_symbols ~source:text + ~kind_file:(Document.kind uri) + in + (ok (Some (`DocumentSymbol resp)), state)) + | CodeAction {textDocument = {uri}; range = {start; end_}} -> + let source = (Document_store.get ~uri state.store).text in + let resp = + Analysis.Xform.extract_code_actions ~path:(Uri.to_path uri) + ~start_pos:(start.line, start.character) + ~end_pos:(end_.line, end_.character) + ~source ~kind_file:(Document.kind uri) ~debug:false + |> List.map (fun ca -> `CodeAction ca) + in + (ok (Some resp), state) + | TextDocumentCodeLens {textDocument = {uri}} -> + let source = (Document_store.get ~uri state.store).text in + let full = + Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) + in + let resp = + Analysis.Hint.code_lens ~source ~kind_file:(Document.kind uri) ~full + ~debug:false + in + (ok (resp |> Option.value ~default:[]), state) + | InlayHint {textDocument = {uri}; range = {start; end_}} -> + let source = (Document_store.get ~uri state.store).text in + let full = + Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) + in + let resp = + Analysis.Hint.inlay ~source ~kind_file:(Document.kind uri) ~full + ~pos:(start.line, end_.line) (* TODO: max_length should be a config *) + ~max_length:(string_of_int 25) ~debug:false + in + (ok resp, state) + | SemanticTokensFull {textDocument = {uri}} -> + let source = (Document_store.get ~uri state.store).text in + let resp = + Analysis.Semantic_tokens.semantic_tokens ~source + ~kind_file:(Document.kind uri) + in + (ok (Some resp), state) + | TextDocumentRename {textDocument = {uri}; position; newName} -> + let full = + Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) + in + let resp = + match + Analysis.Commands.rename ~full + ~pos:(position.line, position.character) + ~new_name:newName ~debug:false + with + | Some we -> we + | None -> WorkspaceEdit.create () + in + (ok resp, state) + | TextDocumentPrepareRename {textDocument = {uri}; position} -> + let full = + Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) + in + let resp = + match + Analysis.Commands.prepare_rename ~full + ~pos:(position.line, position.character) + ~debug:false + with + | Some {range} -> Some range + | None -> None + in + (ok resp, state) + | TextDocumentFormatting {textDocument = {uri}} -> + let source = (Document_store.get ~uri state.store).text in + + let resp = + match Analysis.Commands.format ~source ~kind_file:(Document.kind uri) with + | Ok text_edit -> Some text_edit + | Error _ -> None + in + (ok resp, state) | _ -> let err = Jsonrpc.Response.Error.make @@ -64,20 +299,36 @@ let on_notification notification (server : State.t Server.t) = let state = Server.state server in match notification with - | Lsp.Client_notification.TextDocumentDidOpen + | Client_notification.TextDocumentDidOpen {textDocument = {uri; text; version; _}} -> - let store = Document_store.open_document ~uri ~text ~version state.store in - let diagnostics = get_updated_diagnostics state in + let store = Document_store.add ~uri ~text ~version state.store in + let diagnostics = get_updated_diagnostics_from_log state in diagnostics |> Diagnostics.send; {state with store} |> State.update_diagnostics diagnostics - | TextDocumentDidChange _ -> state + | TextDocumentDidChange {contentChanges; textDocument = {uri; version}} -> + let store = + match List.rev contentChanges with + | {text} :: _ -> Document_store.update ~uri ~text ~version state.store + | [] -> state.store + in + let diagnostics = get_updated_diagnostics_from_log state in + let syntax_erros_diagnostics = + Diagnostics.from_uri ~uri + (Analysis.Diagnostics.document_syntax + ~source:(Document_store.get ~uri store).text + ~kind_file:(Document.kind uri)) + in + + Diagnostics.append ~new_diagnostics:syntax_erros_diagnostics diagnostics + |> Diagnostics.send; + + {state with store} |> State.update_diagnostics diagnostics | TextDocumentDidClose {textDocument = {uri; _}} -> - let store = Document_store.remove_document ~uri state.store in - let diagnostics = get_updated_diagnostics state in + let store = Document_store.remove ~uri state.store in + let diagnostics = get_updated_diagnostics_from_log state in diagnostics |> Diagnostics.send; {state with store} |> State.update_diagnostics diagnostics | Initialized -> - let open Lsp.Types in (* Register dynamic file watchers for compiler log files. ReScript writes one .compiler.log per build root. In monorepos, .sourcedirs.json contains the build_root entries for each subpackage, @@ -105,7 +356,7 @@ let on_notification notification (server : State.t Server.t) = ~method_:"workspace/didChangeWatchedFiles" ~registerOptions () in let params = RegistrationParams.create ~registrations:[registration] in - Server.request (Lsp.Server_request.ClientRegisterCapability params) server; + Server.request (Server_request.ClientRegisterCapability params) server; state | DidChangeWatchedFiles _ -> @@ -114,7 +365,7 @@ let on_notification notification (server : State.t Server.t) = can change diagnostics that should be shown for files in another subpackage. Re-read every compiler log listed in .sourcedirs.json so stale errors are cleared and cross-package diagnostics stay in sync. *) - let diagnostics = get_updated_diagnostics state in + let diagnostics = get_updated_diagnostics_from_log state in diagnostics |> Diagnostics.send; state |> State.update_diagnostics diagnostics | Exit -> state diff --git a/lsp/src/server.ml b/lsp/src/server.ml index 2f8dec12891..4d41dac733c 100644 --- a/lsp/src/server.ml +++ b/lsp/src/server.ml @@ -164,7 +164,7 @@ let rec input_loop ~input ~state with_ = | Some packet -> let state = with_ state packet in input_loop ~input ~state with_ - | exception _ -> raise (Failure "Server.input_loop") + | exception _ -> failwith "Server.input_loop" | None -> () let listen ~input ~output ~on_request ~on_notification ~state = diff --git a/tests/lsp_tests/test.ml b/tests/lsp_tests/test.ml index 4f92bf9e65c..a767ac164af 100644 --- a/tests/lsp_tests/test.ml +++ b/tests/lsp_tests/test.ml @@ -1,4 +1,5 @@ let ( // ) = Filename.concat +let ( / ) = Eio.Path.( / ) let executable = "_build" // "default" // "lsp" // "bin" // "main.exe" module Client = struct From 015a2d2d0470053d6681318a85a4ba9be3ef33b5 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sun, 7 Jun 2026 15:51:06 -0300 Subject: [PATCH 30/37] Enforce LSP server lifecycle Track initialize, running, and shutdown states in the LSP server loop. Reject requests before initialization with ServerNotInitialized, reject requests after shutdown with InvalidRequest, and allow exit notifications to terminate with the correct status code. Also make unsupported requests and notifications explicit in the language server handlers. --- lsp/src/rescript_language_server.ml | 45 ++++++++++++++--- lsp/src/server.ml | 78 ++++++++++++++++++++++++----- 2 files changed, 104 insertions(+), 19 deletions(-) diff --git a/lsp/src/rescript_language_server.ml b/lsp/src/rescript_language_server.ml index 38aef8a7c53..7df1dbc77ed 100644 --- a/lsp/src/rescript_language_server.ml +++ b/lsp/src/rescript_language_server.ml @@ -101,7 +101,6 @@ let on_request (Client_request.E request) (server : State.t Server.t) = | Client_request.Initialize params -> let initialization_info, state = on_initialize params server in (ok initialization_info, state) - | Shutdown -> (ok (), state) | TextDocumentHover {position; textDocument = {uri}} -> let source = (Document_store.get ~uri state.store).text in let full = @@ -287,11 +286,35 @@ let on_request (Client_request.E request) (server : State.t Server.t) = | Error _ -> None in (ok resp, state) - | _ -> + | Shutdown -> (ok (), state) + | DebugTextDocumentGet _ | DebugEcho _ | WorkspaceSymbol _ + | CodeActionResolve _ | ExecuteCommand _ | TextDocumentColor _ + | TextDocumentColorPresentation _ | TextDocumentCodeLensResolve _ + | TextDocumentHighlight _ | TextDocumentFoldingRange _ + | TextDocumentLinkResolve _ | TextDocumentLink _ + | WillSaveWaitUntilTextDocument _ | TextDocumentRangeFormatting _ + | TextDocumentOnTypeFormatting _ | SelectionRange _ + | TextDocumentImplementation _ | SemanticTokensDelta _ | TextDocumentMoniker _ + | TextDocumentPrepareCallHierarchy _ | CallHierarchyIncomingCalls _ + | CallHierarchyOutgoingCalls _ | SemanticTokensRange _ | LinkedEditingRange _ + | WillCreateFiles _ | WillRenameFiles _ | WillDeleteFiles _ + | InlayHintResolve _ | TextDocumentDiagnostic _ + | TextDocumentInlineCompletion _ | TextDocumentInlineValue _ + | WorkspaceSymbolResolve _ | WorkspaceDiagnostic _ + | TextDocumentRangesFormatting _ | TextDocumentPrepareTypeHierarchy _ + | TypeHierarchySupertypes _ | TypeHierarchySubtypes _ + | TextDocumentDeclaration _ -> + let err = + Jsonrpc.Response.Error.make ~message:"Request not supported yet!" + ~code:InternalError () + in + (Error err, state) + | UnknownRequest {meth} -> let err = Jsonrpc.Response.Error.make - ~code:Jsonrpc.Response.Error.Code.MethodNotFound - ~message:"Request method not supported" () + ~code:Jsonrpc.Response.Error.Code.InvalidRequest + ~message:(Printf.sprintf "Unknown request %s" meth) + () in (Error err, state) @@ -359,6 +382,7 @@ let on_notification notification (server : State.t Server.t) = Server.request (Server_request.ClientRegisterCapability params) server; state + | Exit -> state | DidChangeWatchedFiles _ -> (* Do not limit diagnostics to the path reported by DidChangeWatchedFilesParams. In monorepos, a build in one subpackage @@ -368,8 +392,17 @@ let on_notification notification (server : State.t Server.t) = let diagnostics = get_updated_diagnostics_from_log state in diagnostics |> Diagnostics.send; state |> State.update_diagnostics diagnostics - | Exit -> state - | _ -> state + | ChangeConfiguration _ | ChangeWorkspaceFolders _ | CancelRequest _ + | DidSaveTextDocument _ | DidCreateFiles _ | DidDeleteFiles _ + | DidRenameFiles _ | WillSaveTextDocument _ | WorkDoneProgressCancel _ + | WorkDoneProgress _ | NotebookDocumentDidOpen _ | NotebookDocumentDidChange _ + | NotebookDocumentDidSave _ | NotebookDocumentDidClose _ | SetTrace _ -> + state + | UnknownNotification {method_} -> + Server.log_message_notification ~kind:MessageType.Error + ("Unknown notication " ^ method_) + server; + state let listen ~input ~output ~fs = let state = State.create ~store:(Document_store.create ()) ~fs in diff --git a/lsp/src/server.ml b/lsp/src/server.ml index 4d41dac733c..92c758d2f74 100644 --- a/lsp/src/server.ml +++ b/lsp/src/server.ml @@ -159,6 +159,29 @@ let show_message_notification ?(kind = Lsp.Types.MessageType.Info) message (Lsp.Types.ShowMessageParams.create ~type_:kind ~message)) server +type lifecycle = Awaiting_initialize | Running | Shutdown_requested + +let error_response ~id ~code ~message = + let err = Jsonrpc.Response.Error.make ~code ~message () in + Jsonrpc.Response.{id; result = Error err} + +let is_initialize_request (request : Jsonrpc.Request.t) = + request.method_ = "initialize" + +let is_shutdown_request (request : Jsonrpc.Request.t) = + request.method_ = "shutdown" + +let is_exit_notification (notification : Jsonrpc.Notification.t) = + notification.method_ = "exit" + +let exit_from_lifecycle lifecycle = + let exit_code = + match lifecycle with + | Shutdown_requested -> 0 + | _ -> 1 + in + exit exit_code + let rec input_loop ~input ~state with_ = match Io.await @@ Lsp_Io.read input with | Some packet -> @@ -168,22 +191,51 @@ let rec input_loop ~input ~state with_ = | None -> () let listen ~input ~output ~on_request ~on_notification ~state = + let lifecycle = ref Awaiting_initialize in 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}, state) - | Ok packed -> - let result, state = on_request packed server in - (Jsonrpc.Response.{id = request.id; result}, state) - in - respond server response; - state + match !lifecycle with + | Awaiting_initialize when not (is_initialize_request request) -> + respond server + (error_response ~id:request.id + ~code:Jsonrpc.Response.Error.Code.ServerNotInitialized + ~message:"Server has not received an initialize request"); + server.state + | Running when is_initialize_request request -> + respond server + (error_response ~id:request.id + ~code:Jsonrpc.Response.Error.Code.InvalidRequest + ~message:"Server has already been initialized"); + server.state + | Shutdown_requested -> + respond server + (error_response ~id:request.id + ~code:Jsonrpc.Response.Error.Code.InvalidRequest + ~message:"Server has already received a shutdown request"); + server.state + | Awaiting_initialize | Running -> + 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}, state) + | Ok packed -> + let result, state = on_request packed server in + (Jsonrpc.Response.{id = request.id; result}, state) + in + respond server response; + (match response.result with + | Ok _ when is_initialize_request request -> lifecycle := Running + | Ok _ when is_shutdown_request request -> lifecycle := Shutdown_requested + | Ok _ | Error _ -> ()); + state in let handle_notification server notification = - on_notification (notification_of_jsonrpc notification) server + if is_exit_notification notification then exit_from_lifecycle !lifecycle + else + match !lifecycle with + | Awaiting_initialize | Shutdown_requested -> server.state + | Running -> on_notification (notification_of_jsonrpc notification) server in let input = Chan.of_source input in Chan.with_sink output (fun channel -> From bbcb7b9388c5a577fa1fa71f5feabe881db1f978 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sun, 7 Jun 2026 17:10:15 -0300 Subject: [PATCH 31/37] analysis refactor: remove global state `Shared_types.state` --- analysis/bin/main.ml | 41 +++-- analysis/src/cli.ml | 104 +++++------ analysis/src/cmt.ml | 16 +- analysis/src/cmt_viewer.ml | 4 +- analysis/src/commands.ml | 45 ++--- analysis/src/completion_back_end.ml | 270 +++++++++++++++------------- analysis/src/create_interface.ml | 4 +- analysis/src/hover.ml | 83 +++++---- analysis/src/packages.ml | 7 +- analysis/src/process_cmt.ml | 7 +- analysis/src/references.ml | 97 +++++----- analysis/src/resolve_path.ml | 31 ++-- analysis/src/shared_types.ml | 18 +- analysis/src/xform.ml | 35 ++-- tools/bin/main.ml | 3 +- tools/src/migrate.ml | 5 +- tools/src/tools.ml | 6 +- 17 files changed, 423 insertions(+), 353 deletions(-) diff --git a/analysis/bin/main.ml b/analysis/bin/main.ml index f57103378be..5594e2b6684 100644 --- a/analysis/bin/main.ml +++ b/analysis/bin/main.ml @@ -92,6 +92,7 @@ Options: |} let main () = + let state = Shared_types.create_state () in let args = Array.to_list Sys.argv in let debug_level, args = match args with @@ -118,7 +119,7 @@ let main () = | [_; "cache-project"; root_path] -> ( Cfg.read_project_config_cache := false; let uri = Uri.from_path root_path in - match Packages.get_package ~uri with + match Packages.get_package ~state ~uri with | Some package -> Cache.cache_project package | None -> print_endline "\"ERR\"") | [_; "cache-delete"; root_path] -> ( @@ -136,18 +137,20 @@ let main () = print_header_info path line col; Cli.completion ~debug ~path ~pos:(int_of_string line, int_of_string col) - ~current_file + ~current_file ~state | [_; "completionResolve"; path; module_path] -> - Cli.completion_resolve ~path ~module_path + Cli.completion_resolve ~state ~path ~module_path | [_; "definition"; path; line; col] -> - Cli.definition ~path ~pos:(int_of_string line, int_of_string col) ~debug + Cli.definition ~state ~path + ~pos:(int_of_string line, int_of_string col) + ~debug | [_; "typeDefinition"; path; line; col] -> - Cli.type_definition ~path + Cli.type_definition ~state ~path ~pos:(int_of_string line, int_of_string col) ~debug | [_; "documentSymbol"; path] -> Cli.document_symbol ~path | [_; "hover"; path; line; col; current_file; supports_markdown_links] -> - Cli.hover ~path + Cli.hover ~state ~path ~pos:(int_of_string line, int_of_string col) ~current_file ~debug ~supports_markdown_links: @@ -163,7 +166,7 @@ let main () = current_file; allow_for_constructor_payloads; ] -> - Cli.signature_help ~path + Cli.signature_help ~state ~path ~pos:(int_of_string line, int_of_string col) ~current_file ~debug ~allow_for_constructor_payloads: @@ -171,14 +174,14 @@ let main () = | "true" -> true | _ -> false) | [_; "inlayHint"; path; line_start; line_end; max_length] -> - Cli.inlayhint ~path + Cli.inlayhint ~state ~path ~pos:(int_of_string line_start, int_of_string line_end) ~max_length ~debug - | [_; "codeLens"; path] -> Cli.code_lens ~path ~debug + | [_; "codeLens"; path] -> Cli.code_lens ~state ~path ~debug | [ _; "codeAction"; path; start_line; start_col; end_line; end_col; current_file; ] -> - Cli.code_action ~path + Cli.code_action ~state ~path ~start_pos:(int_of_string start_line, int_of_string start_col) ~end_pos:(int_of_string end_line, int_of_string end_col) ~current_file ~debug @@ -197,23 +200,27 @@ let main () = |> print_endline | [_; "diagnosticSyntax"; path] -> Cli.diagnostic_syntax ~path | [_; "references"; path; line; col] -> - Cli.references ~path ~pos:(int_of_string line, int_of_string col) ~debug + Cli.references ~state ~path + ~pos:(int_of_string line, int_of_string col) + ~debug | [_; "prepareRename"; path; line; col] -> - Cli.prepare_rename ~path ~pos:(int_of_string line, int_of_string col) ~debug + Cli.prepare_rename ~state ~path + ~pos:(int_of_string line, int_of_string col) + ~debug | [_; "rename"; path; line; col; new_name] -> - Cli.rename ~path + Cli.rename ~state ~path ~pos:(int_of_string line, int_of_string col) ~new_name ~debug | [_; "semanticTokens"; current_file] -> Cli.semantic_tokens ~path:current_file | [_; "createInterface"; path; cmi_file] -> - `String (Create_interface.command ~path ~cmi_file) + `String (Create_interface.command ~state ~path ~cmi_file) |> Yojson.Safe.pretty_to_string ~std:true |> print_endline - | [_; "format"; path] -> Cli.format ~path - | [_; "test"; path] -> Cli.test ~path + | [_; "format"; path] -> Cli.format ~state ~path + | [_; "test"; path] -> Cli.test ~state ~path | [_; "cmt"; rescript_json; cmt_path] -> - Cmt_viewer.dump rescript_json cmt_path + Cmt_viewer.dump ~state rescript_json cmt_path | args when List.mem "-h" args || List.mem "--help" args -> prerr_endline help | _ -> prerr_endline help; diff --git a/analysis/src/cli.ml b/analysis/src/cli.ml index 78d6c86a5f8..5801f2f5ff4 100644 --- a/analysis/src/cli.ml +++ b/analysis/src/cli.ml @@ -3,24 +3,24 @@ let print_string json = let print_null () = `Null |> print_string let print_list l = `List l |> print_string -let completion ~debug ~path ~pos ~current_file = - let full = Cmt.load_full_cmt_from_path ~path in +let completion ~state ~debug ~path ~pos ~current_file = + let full = Cmt.load_full_cmt_from_path ~state ~path in let kind_file = Files.classify_source_file current_file in match Files.read_file current_file with | None | Some "" -> print_null () | Some source -> - Commands.completion ~debug ~source ~kind_file ~pos ~full + Commands.completion ~state ~debug ~source ~kind_file ~pos ~full |> List.map (fun c -> Lsp.Types.CompletionItem.yojson_of_t c) |> print_list -let completion_resolve ~path ~module_path = - let full = Cmt.load_full_cmt_from_path ~path in - match Commands.completion_resolve ~full ~module_path with +let completion_resolve ~state ~path ~module_path = + let full = Cmt.load_full_cmt_from_path ~state ~path in + match Commands.completion_resolve ~state ~full ~module_path with | None -> print_null () | Some (`MarkupContent {value}) -> `String value |> print_string -let inlayhint ~path ~pos ~max_length ~debug = - let full = Cmt.load_full_cmt_from_path ~path in +let inlayhint ~state ~path ~pos ~max_length ~debug = + let full = Cmt.load_full_cmt_from_path ~state ~path in let kind_file = Files.classify_source_file path in match Files.read_file path with | None -> print_null () @@ -32,8 +32,8 @@ let inlayhint ~path ~pos ~max_length ~debug = |> print_list | None -> print_null ()) -let code_lens ~path ~debug = - let full = Cmt.load_full_cmt_from_path ~path in +let code_lens ~state ~path ~debug = + let full = Cmt.load_full_cmt_from_path ~state ~path in let kind_file = Files.classify_source_file path in match Files.read_file path with | None -> print_null () @@ -43,68 +43,68 @@ let code_lens ~path ~debug = lens |> List.map (fun l -> Lsp.Types.CodeLens.yojson_of_t l) |> print_list | None -> print_null ()) -let hover ~path ~pos ~current_file ~debug ~supports_markdown_links = - let full = Cmt.load_full_cmt_from_path ~path in +let hover ~state ~path ~pos ~current_file ~debug ~supports_markdown_links = + let full = Cmt.load_full_cmt_from_path ~state ~path in let kind_file = Files.classify_source_file current_file in match Files.read_file current_file with | None -> print_null () | Some source -> ( match Commands.hover ~source ~kind_file ~pos ~debug ~supports_markdown_links - ~full + ~state ~full with | Some value -> Lsp.Types.Hover.yojson_of_t value |> print_string | None -> print_null ()) -let signature_help ~path ~pos ~current_file ~debug +let signature_help ~state ~path ~pos ~current_file ~debug ~allow_for_constructor_payloads = - let full = Cmt.load_full_cmt_from_path ~path in + let full = Cmt.load_full_cmt_from_path ~state ~path in let kind_file = Files.classify_source_file current_file in match Files.read_file current_file with | None -> print_null () | Some source -> ( match - Signature_help.signature_help ~source ~kind_file ~pos + Commands.signature_help ~state ~source ~kind_file ~pos ~allow_for_constructor_payloads ~full ~debug with | None -> print_null () | Some s -> Lsp.Types.SignatureHelp.yojson_of_t s |> print_string) -let code_action ~path ~start_pos ~end_pos ~current_file ~debug = +let code_action ~state ~path ~start_pos ~end_pos ~current_file ~debug = let kind_file = Files.classify_source_file current_file in match Files.read_file current_file with | None -> print_null () | Some source -> - Xform.extract_code_actions ~path ~start_pos ~end_pos ~source ~kind_file - ~debug + Xform.extract_code_actions ~state ~path ~start_pos ~end_pos ~source + ~kind_file ~debug |> List.map (fun c -> Lsp.Types.CodeAction.yojson_of_t c) |> print_list -let definition ~path ~pos ~debug = - let full = Cmt.load_full_cmt_from_path ~path in +let definition ~state ~path ~pos ~debug = + let full = Cmt.load_full_cmt_from_path ~state ~path in - match Commands.definition ~full ~pos ~debug with + match Commands.definition ~state ~full ~pos ~debug with | None -> print_null () | Some location -> location |> Lsp.Types.Location.yojson_of_t |> print_string -let type_definition ~path ~pos ~debug = - let full = Cmt.load_full_cmt_from_path ~path in - match Commands.type_definition ~full ~pos ~debug with +let type_definition ~state ~path ~pos ~debug = + let full = Cmt.load_full_cmt_from_path ~state ~path in + match Commands.type_definition ~state ~full ~pos ~debug with | None -> print_null () | Some location -> location |> Lsp.Types.Location.yojson_of_t |> print_string -let references ~path ~pos ~debug = - let full = Cmt.load_full_cmt_from_path ~path in - let all_locs = Commands.references ~full ~pos ~debug in +let references ~state ~path ~pos ~debug = + let full = Cmt.load_full_cmt_from_path ~state ~path in + let all_locs = Commands.references ~state ~full ~pos ~debug in if all_locs = [] then print_null () else all_locs |> List.map (fun l -> Lsp.Types.Location.yojson_of_t l) |> print_list -let rename ~path ~pos ~new_name ~debug = - let full = Cmt.load_full_cmt_from_path ~path in - match Commands.rename ~full ~pos ~new_name ~debug with +let rename ~state ~path ~pos ~new_name ~debug = + let full = Cmt.load_full_cmt_from_path ~state ~path in + match Commands.rename ~state ~full ~pos ~new_name ~debug with | Some {documentChanges = Some document_changes} -> document_changes |> List.map (fun c -> @@ -116,9 +116,9 @@ let rename ~path ~pos ~new_name ~debug = |> print_list | _ -> print_null () -let prepare_rename ~path ~pos ~debug = - let full = Cmt.load_full_cmt_from_path ~path in - match Commands.prepare_rename ~full ~pos ~debug with +let prepare_rename ~state ~path ~pos ~debug = + let full = Cmt.load_full_cmt_from_path ~state ~path in + match Commands.prepare_rename ~state ~full ~pos ~debug with | None -> print_null () | Some {range; placeholder = None} -> Lsp.Types.Range.yojson_of_t range |> print_string @@ -130,12 +130,12 @@ let prepare_rename ~path ~pos ~debug = ] |> print_string -let format ~path = +let format ~state ~path = match Files.read_file path with | None -> print_null () | Some source -> ( let kind_file = Files.classify_source_file path in - match Commands.format ~source ~kind_file with + match Commands.format ~state ~source ~kind_file with | Ok text_edits -> ( match text_edits with | {newText} :: _ -> print_string (`String newText) @@ -168,7 +168,7 @@ let document_symbol ~path = |> List.map Lsp.Types.DocumentSymbol.yojson_of_t |> print_list -let test ~path = +let test ~state ~path = Uri.strip_path := true; match Files.read_file path with | None -> assert false @@ -233,19 +233,19 @@ let test ~path = print_endline ("Definition " ^ path ^ " " ^ string_of_int line ^ ":" ^ string_of_int col); - definition ~path ~pos:(line, col) ~debug:true + definition ~state ~path ~pos:(line, col) ~debug:true | "com" -> print_endline ("Complete " ^ path ^ " " ^ string_of_int line ^ ":" ^ string_of_int col); let current_file = create_current_file () in - completion ~debug:true ~path ~pos:(line, col) ~current_file; + completion ~state ~debug:true ~path ~pos:(line, col) ~current_file; Sys.remove current_file | "cre" -> let module_path = String.sub rest 3 (String.length rest - 3) in let module_path = String.trim module_path in print_endline ("Completion resolve: " ^ module_path); - completion_resolve ~path ~module_path + completion_resolve ~state ~path ~module_path | "dce" -> print_endline ("DCE " ^ path); Reanalyze.Run_config.run_config.suppress <- ["src"]; @@ -268,7 +268,7 @@ let test ~path = ("Hover " ^ path ^ " " ^ string_of_int line ^ ":" ^ string_of_int col); let current_file = create_current_file () in - hover ~supports_markdown_links:true ~path ~pos:(line, col) + hover ~state ~supports_markdown_links:true ~path ~pos:(line, col) ~current_file ~debug:true; Sys.remove current_file | "she" -> @@ -276,8 +276,8 @@ let test ~path = ("Signature help " ^ path ^ " " ^ string_of_int line ^ ":" ^ string_of_int col); let current_file = create_current_file () in - signature_help ~path ~pos:(line, col) ~current_file ~debug:true - ~allow_for_constructor_payloads:true; + signature_help ~state ~path ~pos:(line, col) ~current_file + ~debug:true ~allow_for_constructor_payloads:true; Sys.remove current_file | "int" -> print_endline ("Create Interface " ^ path); @@ -288,17 +288,17 @@ let test ~path = let dir = dirname path in dir ++ parent_dir_name ++ "lib" ++ "bs" ++ "src" ++ name in - Printf.printf "%s" (Create_interface.command ~path ~cmi_file) + Printf.printf "%s" (Create_interface.command ~state ~path ~cmi_file) | "ref" -> print_endline ("References " ^ path ^ " " ^ string_of_int line ^ ":" ^ string_of_int col); - references ~path ~pos:(line, col) ~debug:true + references ~state ~path ~pos:(line, col) ~debug:true | "pre" -> print_endline ("PrepareRename " ^ path ^ " " ^ string_of_int line ^ ":" ^ string_of_int col); - prepare_rename ~path ~pos:(line, col) ~debug:true + prepare_rename ~state ~path ~pos:(line, col) ~debug:true | "ren" -> let new_name = String.sub rest 4 (len - mlen - 4) in let () = @@ -306,12 +306,12 @@ let test ~path = ("Rename " ^ path ^ " " ^ string_of_int line ^ ":" ^ string_of_int col ^ " " ^ new_name) in - rename ~path ~pos:(line, col) ~new_name ~debug:true + rename ~state ~path ~pos:(line, col) ~new_name ~debug:true | "typ" -> print_endline ("TypeDefinition " ^ path ^ " " ^ string_of_int line ^ ":" ^ string_of_int col); - type_definition ~path ~pos:(line, col) ~debug:true + type_definition ~state ~path ~pos:(line, col) ~debug:true | "xfm" -> let current_file = create_current_file () in (* +2 is to ensure that the character ^ points to is what's considered the end of the selection. *) @@ -332,8 +332,8 @@ let test ~path = in let kind_file = Files.classify_source_file current_file in let code_actions = - Xform.extract_code_actions ~path ~start_pos ~end_pos ~source - ~kind_file ~debug:true + Xform.extract_code_actions ~state ~path ~start_pos ~end_pos + ~source ~kind_file ~debug:true in Sys.remove current_file; code_actions @@ -411,11 +411,11 @@ let test ~path = print_endline ("Inlay Hint " ^ path ^ " " ^ string_of_int line_start ^ ":" ^ string_of_int line_end); - inlayhint ~path ~pos:(line_start, line_end) ~max_length:"25" + inlayhint ~state ~path ~pos:(line_start, line_end) ~max_length:"25" ~debug:false | "cle" -> print_endline ("Code Lens " ^ path); - code_lens ~path ~debug:false + code_lens ~state ~path ~debug:false | "ast" -> print_endline ("Dump AST " ^ path ^ " " ^ string_of_int line ^ ":" diff --git a/analysis/src/cmt.ml b/analysis/src/cmt.ml index 2556ed56150..b17e04478ae 100644 --- a/analysis/src/cmt.ml +++ b/analysis/src/cmt.ml @@ -34,9 +34,9 @@ let full_from_module_uri ~package ~module_name ~uri ~paths = let cmt = get_cmt_path ~uri paths in full_for_cmt ~module_name ~package ~uri cmt -let full_from_uri ~uri = +let full_from_uri ~state ~uri = let path = Uri.to_path uri in - match Packages.get_package ~uri with + match Packages.get_package ~state ~uri with | None -> None | Some package -> ( let module_name = @@ -53,13 +53,13 @@ let full_from_uri ~uri = prerr_endline ("can't find module " ^ module_name); None)) -let full_from_module ~package ~module_name = +let full_from_module ?state:_ ~package ~module_name = Option.bind (Hashtbl.find_opt package.paths_for_module module_name) @@ fun paths -> let uri = get_uri paths in full_from_module_uri ~package ~module_name ~uri ~paths -let fulls_from_module ~package ~module_name = +let fulls_from_module ?state:_ ~package ~module_name = match Hashtbl.find_opt package.paths_for_module module_name with | None -> [] | Some paths -> @@ -68,13 +68,13 @@ let fulls_from_module ~package ~module_name = |> List.filter_map (fun uri -> full_from_module_uri ~package ~module_name ~uri ~paths) -let load_full_cmt_from_path ~path = +let load_full_cmt_from_path ~state ~path = let uri = Uri.from_path path in - full_from_uri ~uri + full_from_uri ~state ~uri -let load_cmt_infos_from_path ~path = +let load_cmt_infos_from_path ~state ~path = let uri = Uri.from_path path in - match Packages.get_package ~uri with + match Packages.get_package ~state ~uri with | None -> None | Some package -> ( let module_name = diff --git a/analysis/src/cmt_viewer.ml b/analysis/src/cmt_viewer.ml index 39bf9f544f8..ce32f8885bc 100644 --- a/analysis/src/cmt_viewer.ml +++ b/analysis/src/cmt_viewer.ml @@ -16,11 +16,11 @@ let filter_by_cursor cursor (loc : Warnings.loc) : bool = type filter = Cursor of (int * int) | Loc of Loc.t -let dump ?filter rescript_json cmt_path = +let dump ~state ?filter rescript_json cmt_path = let uri = Uri.from_path (Filename.remove_extension cmt_path ^ ".res") in let package = let uri = Uri.from_path rescript_json in - Packages.get_package ~uri |> Option.get + Packages.get_package ~state ~uri |> Option.get in let module_name = Build_system.namespaced_name package.namespace diff --git a/analysis/src/commands.ml b/analysis/src/commands.ml index be6c0a83c46..adbd21be706 100644 --- a/analysis/src/commands.ml +++ b/analysis/src/commands.ml @@ -1,13 +1,14 @@ -let completion ~debug ~source ~kind_file ~pos ~full = +let completion ~state ~debug ~source ~kind_file ~pos ~full = match Completions.get_completions ~debug ~source ~kind_file ~pos ~full ~for_hover:false with | None -> [] | Some (completions, full, _) -> - completions |> List.map (Completion_back_end.completion_to_item ~full) + completions + |> List.map (Completion_back_end.completion_to_item ~state ~full) -let completion_resolve ~(full : Shared_types.full option) ~module_path = +let completion_resolve ~state ~(full : Shared_types.full option) ~module_path = (* We ignore the internal module path as of now because there's currently no use case for it. But, if we wanted to move resolving documentation for regular modules and not just file modules to the completionResolve @@ -25,7 +26,9 @@ let completion_resolve ~(full : Shared_types.full option) ~module_path = Printf.printf "[completion_resolve] Could not load cmt\n"; None | Some full -> ( - match Process_cmt.file_for_module ~package:full.package module_name with + match + Process_cmt.file_for_module ~state ~package:full.package module_name + with | None -> if Debug.verbose () then Printf.printf "[completion_resolve] Did not find file for module %s\n" @@ -41,7 +44,7 @@ let completion_resolve ~(full : Shared_types.full option) ~module_path = (Lsp.Types.MarkupContent.create ~kind:Lsp.Types.MarkupKind.Markdown ~value)) -let hover ~source ~kind_file ~pos ~supports_markdown_links ~full ~debug = +let hover ~state ~source ~kind_file ~pos ~supports_markdown_links ~full ~debug = let result = match full with | None -> None @@ -52,7 +55,7 @@ let hover ~source ~kind_file ~pos ~supports_markdown_links ~full ~debug = Printf.printf "Nothing at that position. Now trying to use completion.\n"; match - Hover.get_hover_via_completions ~debug ~source ~kind_file ~pos + Hover.get_hover_via_completions ~debug ~source ~kind_file ~pos ~state ~for_hover:true ~supports_markdown_links ~full:(Some full) with | None -> None @@ -63,7 +66,9 @@ let hover ~source ~kind_file ~pos ~supports_markdown_links ~full ~debug = | LModule _ | TopLevelModule _ -> true | TypeDefinition _ | Typed _ | Constant _ -> false in - let uri_loc_opt = References.definition_for_loc_item ~full loc_item in + let uri_loc_opt = + References.definition_for_loc_item ~state ~full loc_item + in let skip_zero = match uri_loc_opt with | None -> false @@ -77,7 +82,7 @@ let hover ~source ~kind_file ~pos ~supports_markdown_links ~full ~debug = && pos_is_zero loc.loc_end in if skip_zero then None - else Hover.new_hover ~supports_markdown_links ~full loc_item) + else Hover.new_hover ~state ~supports_markdown_links ~full loc_item) in match result with | None -> None @@ -90,12 +95,12 @@ let hover ~source ~kind_file ~pos ~supports_markdown_links ~full ~debug = ~kind:Lsp.Types.MarkupKind.Markdown ~value)) ()) -let signature_help ~source ~kind_file ~pos ~allow_for_constructor_payloads ~full - ~debug = +let signature_help ~state:_ ~source ~kind_file ~pos + ~allow_for_constructor_payloads ~full ~debug = Signature_help.signature_help ~debug ~source ~kind_file ~pos ~allow_for_constructor_payloads ~full -let definition ~full ~pos ~debug = +let definition ~state ~full ~pos ~debug = let location_opt = match full with | None -> None @@ -103,7 +108,7 @@ let definition ~full ~pos ~debug = match References.get_loc_item ~full ~pos ~debug with | None -> None | Some loc_item -> ( - match References.definition_for_loc_item ~full loc_item with + match References.definition_for_loc_item ~state ~full loc_item with | None -> None | Some (uri, loc) when not loc.loc_ghost -> let is_interface = full.file.uri |> Uri.is_interface in @@ -130,7 +135,7 @@ let definition ~full ~pos ~debug = in location_opt -let type_definition ~full ~pos ~debug = +let type_definition ~state ~full ~pos ~debug = let maybe_location = match full with | None -> None @@ -138,7 +143,7 @@ let type_definition ~full ~pos ~debug = match References.get_loc_item ~full ~pos ~debug with | None -> None | Some loc_item -> ( - match References.type_definition_for_loc_item ~full loc_item with + match References.type_definition_for_loc_item ~state ~full loc_item with | None -> None | Some (uri, loc) -> Some @@ -148,7 +153,7 @@ let type_definition ~full ~pos ~debug = in maybe_location -let references ~full ~pos ~debug = +let references ~state ~full ~pos ~debug = let all_locs = match full with | None -> [] @@ -157,7 +162,7 @@ let references ~full ~pos ~debug = | None -> [] | Some loc_item -> let all_references = - References.all_references_for_loc_item ~full loc_item + References.all_references_for_loc_item ~state ~full loc_item in all_references |> List.fold_left @@ -176,7 +181,7 @@ let references ~full ~pos ~debug = in all_locs -let rename ~full ~pos ~new_name ~debug = +let rename ~state ~full ~pos ~new_name ~debug = let result = match full with | None -> None @@ -185,7 +190,7 @@ let rename ~full ~pos ~new_name ~debug = | None -> None | Some loc_item -> let all_references = - References.all_references_for_loc_item ~full loc_item + References.all_references_for_loc_item ~state ~full loc_item in let references_to_toplevel_modules = all_references @@ -261,7 +266,7 @@ type prepare_rename_result = { placeholder: string option; } -let prepare_rename ~full ~pos ~debug = +let prepare_rename ~state:_ ~full ~pos ~debug = match full with | None -> None | Some full -> ( @@ -278,7 +283,7 @@ let prepare_rename ~full ~pos ~debug = in Some {range; placeholder = placeholder_opt}) -let format ~source ~kind_file = +let format ~state:_ ~source ~kind_file = let create_range text = let lines = text |> String.split_on_char '\n' in let lines_len = List.length lines in diff --git a/analysis/src/completion_back_end.ml b/analysis/src/completion_back_end.ml index 66524705675..8071bc06007 100644 --- a/analysis/src/completion_back_end.ml +++ b/analysis/src/completion_back_end.ml @@ -27,7 +27,8 @@ let show_constructor {Constructor.cname = {txt}; args; res} = | Some typ -> "\n" ^ (typ |> Shared.type_to_string) (* TODO: local opens *) -let resolve_opens ~env opens ~package = +let resolve_opens ?state ~env opens ~package = + let state = Option.value state ~default:package.state in List.fold_left (fun previous path -> (* Finding an open, first trying to find it in previoulsly resolved opens *) @@ -37,13 +38,13 @@ let resolve_opens ~env opens ~package = match path with | [] | [_] -> previous | name :: path -> ( - match Process_cmt.file_for_module ~package name with + match Process_cmt.file_for_module ~state ~package name with | None -> Log.log ("Could not get module " ^ name); previous (* TODO: warn? *) | Some file -> ( match - Resolve_path.resolve_path ~env:(Query_env.from_file file) + Resolve_path.resolve_path ~env:(Query_env.from_file file) ~state ~package ~path with | None -> @@ -51,12 +52,12 @@ let resolve_opens ~env opens ~package = previous | Some (env, _placeholder) -> previous @ [env]))) | env :: rest -> ( - match Resolve_path.resolve_path ~env ~package ~path with + match Resolve_path.resolve_path ~state ~env ~package ~path with | None -> loop rest | Some (env, _placeholder) -> previous @ [env]) in Log.log ("resolving open " ^ path_to_string path); - match Resolve_path.resolve_path ~env ~package ~path with + match Resolve_path.resolve_path ~state ~env ~package ~path with | None -> Log.log "Not local"; loop previous @@ -176,23 +177,27 @@ let find_module_in_scope ~env ~module_name ~scope = scope |> Scope.iter_modules_after_first_open process_module; !result -let rec module_item_to_structure_env ~(env : Query_env.t) ~package +let rec module_item_to_structure_env ?state ~(env : Query_env.t) ~package (item : Module.t) = + let state = Option.value state ~default:package.state in match item with | Module.Structure structure -> Some (env, structure) | Module.Constraint (_, module_type) -> - module_item_to_structure_env ~env ~package module_type + module_item_to_structure_env ~state ~env ~package module_type | Module.Ident p -> ( - match Resolve_path.resolve_module_from_compiler_path ~env ~package p with + match + Resolve_path.resolve_module_from_compiler_path ~state ~env ~package p + with | Some (env2, Some declared2) -> - module_item_to_structure_env ~env:env2 ~package declared2.item + module_item_to_structure_env ~state ~env:env2 ~package declared2.item | _ -> None) (* Given a declared module, return the env entered into its concrete structure and the structure itself. Follows constraints and aliases *) -let enter_structure_from_declared ~(env : Query_env.t) ~package +let enter_structure_from_declared ?state ~(env : Query_env.t) ~package (declared : Module.t Declared.t) = - match module_item_to_structure_env ~env ~package declared.item with + let state = Option.value state ~default:package.state in + match module_item_to_structure_env ~state ~env ~package declared.item with | Some (env, s) -> Some (Query_env.enter_structure env s, s) | None -> None @@ -216,8 +221,8 @@ let completions_from_structure_items ~(env : Query_env.t) (Completion.create ~env ~docstring:it.docstring ~kind:(Completion.Type t) it.name)) -let resolve_path_from_stamps ~(env : Query_env.t) ~package ~scope ~module_name - ~path = +let resolve_path_from_stamps ~state ~(env : Query_env.t) ~package ~scope + ~module_name ~path = (* Log.log("Finding from stamps " ++ name); *) match find_module_in_scope ~env ~module_name ~scope with | None -> None @@ -237,63 +242,70 @@ let resolve_path_from_stamps ~(env : Query_env.t) ~package ~scope ~module_name match res with | `Local (env, name) -> Some (env, name) | `Global (module_name, full_path) -> ( - match Process_cmt.file_for_module ~package module_name with + match Process_cmt.file_for_module ~state ~package module_name with | None -> None | Some file -> - Resolve_path.resolve_path ~env:(Query_env.from_file file) + Resolve_path.resolve_path ~env:(Query_env.from_file file) ~state ~path:full_path ~package)))) -let resolve_module_with_opens ~opens ~package ~module_name = +let resolve_module_with_opens ~state ~opens ~package ~module_name = let rec loop opens = match opens with | (env : Query_env.t) :: rest -> ( Log.log ("Looking for env in " ^ Uri.to_string env.file.uri); - match Resolve_path.resolve_path ~env ~package ~path:[module_name; ""] with + match + Resolve_path.resolve_path ~state ~env ~package ~path:[module_name; ""] + with | Some (env, _) -> Some env | None -> loop rest) | [] -> None in loop opens -let resolve_file_module ~module_name ~package = +let resolve_file_module ~state ~module_name ~package = Log.log ("Getting module " ^ module_name); - match Process_cmt.file_for_module ~package module_name with + match Process_cmt.file_for_module ~state ~package module_name with | None -> None | Some file -> Log.log "got it"; let env = Query_env.from_file file in Some env -let get_env_with_opens ~scope ~(env : Query_env.t) ~package +let get_env_with_opens ?state ~scope ~(env : Query_env.t) ~package ~(opens : Query_env.t list) ~module_name (path : string list) = + let state = Option.value state ~default:package.state in (* TODO: handle interleaving of opens and local modules correctly *) - match resolve_path_from_stamps ~env ~scope ~module_name ~path ~package with + match + resolve_path_from_stamps ~state ~env ~scope ~module_name ~path ~package + with | Some x -> Some x | None -> ( let env_opt = - match resolve_module_with_opens ~opens ~package ~module_name with + match resolve_module_with_opens ~state ~opens ~package ~module_name with | Some env_opens -> Some env_opens - | None -> resolve_file_module ~module_name ~package + | None -> resolve_file_module ~state ~module_name ~package in match env_opt with | None -> None | Some env -> ( match path with | [""] -> Some (env, "") - | _ -> Resolve_path.resolve_path ~env ~package ~path)) + | _ -> Resolve_path.resolve_path ~state ~env ~package ~path)) -let rec expand_type_expr ~env ~package type_expr = +let rec expand_type_expr ?state ~env ~package type_expr = + let state = Option.value state ~default:package.state in match type_expr |> Shared.dig_constructor with | Some path -> ( - match References.dig_constructor ~env ~package path with + match References.dig_constructor ~state ~env ~package path with | None -> None | Some (env, {item = {decl = {type_manifest = Some t}}}) -> - expand_type_expr ~env ~package t + expand_type_expr ~state ~env ~package t | Some (_, {docstring; item}) -> Some (docstring, item)) | None -> None -let kind_to_documentation ~env ~full ~current_docstring name +let kind_to_documentation ?state ~env ~full ~current_docstring name (kind : Completion.kind) = + let state = Option.value state ~default:full.package.state in let docs_from_kind = match kind with | ObjLabel _ | Label _ | FileModule _ | Snippet _ | FollowContextPath _ -> @@ -302,7 +314,7 @@ let kind_to_documentation ~env ~full ~current_docstring name | Type {decl; name} -> [decl |> Shared.decl_to_string name |> Markdown.code_block] | Value typ -> ( - match expand_type_expr ~env ~package:full.package typ with + match expand_type_expr ~state ~env ~package:full.package typ with | None -> [] | Some (docstrings, {decl; name; kind}) -> docstrings @@ -699,8 +711,9 @@ let get_complementary_completions_for_typed_value ~opens ~all_files ~scope ~env in local_completions_with_opens @ file_modules -let get_completions_for_path ~debug ~opens ~full ~pos ~exact ~scope +let get_completions_for_path ?state ~debug ~opens ~full ~pos ~exact ~scope ~completion_context ~env path = + let state = Option.value state ~default:full.package.state in if debug then Printf.printf "Path %s\n" (path |> String.concat "."); let all_files = all_files_in_package full.package in match path with @@ -742,15 +755,15 @@ let get_completions_for_path ~debug ~opens ~full ~pos ~exact ~scope | Some (declared : Module.t Declared.t) when declared.is_exported = false -> ( match - enter_structure_from_declared ~env:env_file ~package:full.package - declared + enter_structure_from_declared ~state ~env:env_file + ~package:full.package declared with | None -> [] | Some (env_in_module, structure) -> completions_from_structure_items ~env:env_in_module structure) | _ -> ( match - get_env_with_opens ~scope ~env ~package:full.package ~opens + get_env_with_opens ~state ~scope ~env ~package:full.package ~opens ~module_name path with | Some (env, prefix) -> @@ -761,8 +774,8 @@ let get_completions_for_path ~debug ~opens ~full ~pos ~exact ~scope | None -> [])) | _ -> ( match - get_env_with_opens ~scope ~env ~package:full.package ~opens ~module_name - path + get_env_with_opens ~state ~scope ~env ~package:full.package ~opens + ~module_name path with | Some (env, prefix) -> Log.log "Got the env"; @@ -771,8 +784,10 @@ let get_completions_for_path ~debug ~opens ~full ~pos ~exact ~scope | None -> [])) (** Completions intended for piping, from a completion path. *) -let completions_for_pipe_from_completion_path ~env_completion_is_made_from - ~opens ~pos ~scope ~debug ~prefix ~env ~raw_opens ~full completion_path = +let completions_for_pipe_from_completion_path ?state + ~env_completion_is_made_from ~opens ~pos ~scope ~debug ~prefix ~env + ~raw_opens ~full completion_path = + let state = Option.value state ~default:full.package.state in let completion_path_without_current_module = Type_utils.remove_current_module_if_needed ~env_completion_is_made_from completion_path @@ -788,8 +803,8 @@ let completions_for_pipe_from_completion_path ~env_completion_is_made_from in let completions = completion_path @ [prefix] - |> get_completions_for_path ~debug ~completion_context:Value ~exact:false - ~opens ~full ~pos ~env ~scope + |> get_completions_for_path ~state ~debug ~completion_context:Value + ~exact:false ~opens ~full ~pos ~env ~scope in let completions = completions @@ -798,12 +813,13 @@ let completions_for_pipe_from_completion_path ~env_completion_is_made_from in completions -let rec dig_to_record_fields_for_completion ~debug ~package ~opens ~full ~pos - ~env ~scope path = +let rec dig_to_record_fields_for_completion ?state ~debug ~package ~opens ~full + ~pos ~env ~scope path = + let state = Option.value state ~default:package.state in match path - |> get_completions_for_path ~debug ~completion_context:Type ~exact:true - ~opens ~full ~pos ~env ~scope + |> get_completions_for_path ~state ~debug ~completion_context:Type + ~exact:true ~opens ~full ~pos ~env ~scope with | {kind = Type {kind = Abstract (Some (p, _))}} :: _ -> (* This case happens when what we're looking for is a type alias. @@ -811,8 +827,8 @@ let rec dig_to_record_fields_for_completion ~debug ~package ~opens ~full ~pos ReactDOM.domProps is an alias for JsxEvent.t. *) let path_rev = p |> Utils.expand_path in path_rev |> List.rev - |> dig_to_record_fields_for_completion ~debug ~package ~opens ~full ~pos - ~env ~scope + |> dig_to_record_fields_for_completion ~state ~debug ~package ~opens ~full + ~pos ~env ~scope | {kind = Type {kind = Record fields}} :: _ -> Some fields | _ -> None @@ -854,7 +870,7 @@ let mk_item ?data ?additional_text_edits name ~kind ~detail ~deprecated ?deprecated ?data ?additionalTextEdits:additional_text_edits ?sortText:None ?insertText:None ?insertTextFormat:None ?filterText:None () -let completion_to_item +let completion_to_item ?state { Completion.name; deprecated; @@ -868,6 +884,7 @@ let completion_to_item env; additional_text_edits; } ~full = + let state = Option.value state ~default:full.package.state in let item = mk_item name ?additional_text_edits ?data:(kind_to_data (full.file.uri |> Uri.to_path) kind) @@ -879,8 +896,8 @@ let completion_to_item | Some detail -> detail) ~docstring: (match - kind_to_documentation ~current_docstring:docstring ~full ~env name - kind + kind_to_documentation ~state ~current_docstring:docstring ~full ~env + name kind with | "" -> [] | docstring -> [docstring]) @@ -919,8 +936,9 @@ let completions_get_completion_type ~full completions = | Some {Completion.kind = ExtractedType (typ, _); env} -> Some (typ, env) | _ -> None -let rec completions_get_completion_type2 ~debug ~full ~opens ~raw_opens ~pos - completions = +let rec completions_get_completion_type2 ?state ~debug ~full ~opens ~raw_opens + ~pos completions = + let state = Option.value state ~default:full.package.state in let first_non_synthetic_completion = List.find_opt (fun c -> not c.Completion.synthetic) completions in @@ -932,9 +950,10 @@ let rec completions_get_completion_type2 ~debug ~full ~opens ~raw_opens ~pos Some (TypeExpr typ, env) | Some {Completion.kind = FollowContextPath (ctx_path, scope); env} -> ctx_path - |> get_completions_for_context_path ~debug ~full ~env ~exact:true ~opens - ~raw_opens ~pos ~scope - |> completions_get_completion_type2 ~debug ~full ~opens ~raw_opens ~pos + |> get_completions_for_context_path ~state ~debug ~full ~env ~exact:true + ~opens ~raw_opens ~pos ~scope + |> completions_get_completion_type2 ~state ~debug ~full ~opens ~raw_opens + ~pos | Some {Completion.kind = Type typ; env} -> ( match Type_utils.extract_type_from_resolved_type typ ~env ~full with | None -> None @@ -943,8 +962,9 @@ let rec completions_get_completion_type2 ~debug ~full ~opens ~raw_opens ~pos Some (ExtractedType typ, env) | _ -> None -and completions_get_type_env2 ~debug (completions : Completion.t list) ~full - ~opens ~raw_opens ~pos = +and completions_get_type_env2 ?state ~debug (completions : Completion.t list) + ~full ~opens ~raw_opens ~pos = + let state = Option.value state ~default:full.package.state in let first_non_synthetic_completion = List.find_opt (fun c -> not c.Completion.synthetic) completions in @@ -954,13 +974,14 @@ and completions_get_type_env2 ~debug (completions : Completion.t list) ~full | Some {Completion.kind = Field ({typ}, _); env} -> Some (typ, env) | Some {Completion.kind = FollowContextPath (ctx_path, scope); env} -> ctx_path - |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env - ~exact:true ~scope - |> completions_get_type_env2 ~debug ~full ~opens ~raw_opens ~pos + |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens + ~pos ~env ~exact:true ~scope + |> completions_get_type_env2 ~state ~debug ~full ~opens ~raw_opens ~pos | _ -> None -and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env - ~exact ~scope ?(mode = Regular) context_path = +and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos + ~env ~exact ~scope ?(mode = Regular) context_path = + let state = Option.value state ~default:full.package.state in let env_completion_is_made_from = env in if debug then Printf.printf "ContextPath %s\n" @@ -992,8 +1013,8 @@ and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env | Regular -> ( match cp - |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos - ~env ~exact:true ~scope + |> get_completions_for_context_path ~state ~debug ~full ~opens + ~raw_opens ~pos ~env ~exact:true ~scope |> completions_get_completion_type ~full with | None -> [] @@ -1014,8 +1035,8 @@ and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env if Debug.verbose () then print_endline "[ctx_path]--> CPOption"; match cp - |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos - ~env ~exact:true ~scope + |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens + ~pos ~env ~exact:true ~scope |> completions_get_completion_type ~full with | None -> [] @@ -1029,8 +1050,8 @@ and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env if Debug.verbose () then print_endline "[ctx_path]--> CPAwait"; match cp - |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos - ~env ~exact:true ~scope + |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens + ~pos ~env ~exact:true ~scope |> completions_get_completion_type ~full with | Some (Tpromise (env, typ), _env) -> @@ -1056,7 +1077,7 @@ and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env let use_tvar_lookup = !Cfg.in_incremental_typechecking_mode in let by_path = path - |> get_completions_for_path ~debug ~opens ~full ~pos ~exact + |> get_completions_for_path ~state ~debug ~opens ~full ~pos ~exact ~completion_context ~env ~scope in let has_tvars = @@ -1079,9 +1100,10 @@ and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env if Debug.verbose () then print_endline "[ctx_path]--> CPApply"; match cp - |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos - ~env ~exact:true ~scope - |> completions_get_completion_type2 ~debug ~full ~opens ~raw_opens ~pos + |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens + ~pos ~env ~exact:true ~scope + |> completions_get_completion_type2 ~state ~debug ~full ~opens ~raw_opens + ~pos with | Some ((TypeExpr typ | ExtractedType (Tfunction {typ})), env) -> ( let rec reconstruct_function_type args t_ret = @@ -1130,18 +1152,18 @@ and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env if Debug.verbose () then print_endline "[ctx_path]--> CPField: M.field"; (* M.field *) path @ [field_name] - |> get_completions_for_path ~debug ~opens ~full ~pos ~exact + |> get_completions_for_path ~state ~debug ~opens ~full ~pos ~exact ~completion_context:Field ~env ~scope | CPField {context_path = cp; field_name; pos_of_dot; expr_loc; in_jsx} -> ( if Debug.verbose () then print_endline "[dot_completion]--> Triggered"; let completions_from_ctx_path = cp - |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos - ~env ~exact:true ~scope + |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens + ~pos ~env ~exact:true ~scope in let main_type_completion_env = completions_from_ctx_path - |> completions_get_type_env2 ~debug ~full ~opens ~raw_opens ~pos + |> completions_get_type_env2 ~state ~debug ~full ~opens ~raw_opens ~pos in match main_type_completion_env with | None -> @@ -1172,8 +1194,8 @@ and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env in let pipe_completions = cp_as_pipe_completion - |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos - ~env:env_completion_is_made_from ~exact ~scope + |> get_completions_for_context_path ~state ~debug ~full ~opens + ~raw_opens ~pos ~env:env_completion_is_made_from ~exact ~scope |> List.filter_map (fun c -> Type_utils.transform_completion_to_pipe_completion ~synthetic:true ~env ?pos_of_dot c) @@ -1184,9 +1206,9 @@ and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env if Debug.verbose () then print_endline "[ctx_path]--> CPObj"; match cp - |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos - ~env ~exact:true ~scope - |> completions_get_type_env2 ~debug ~full ~opens ~raw_opens ~pos + |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens + ~pos ~env ~exact:true ~scope + |> completions_get_type_env2 ~state ~debug ~full ~opens ~raw_opens ~pos with | Some (typ, env) -> ( match typ |> Type_utils.extract_object_type ~env ~package with @@ -1205,9 +1227,9 @@ and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env let env_at_cursor = env in match cp - |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos - ~env ~exact:true ~scope ~mode:Pipe - |> completions_get_type_env2 ~debug ~full ~opens ~raw_opens ~pos + |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens + ~pos ~env ~exact:true ~scope ~mode:Pipe + |> completions_get_type_env2 ~state ~debug ~full ~opens ~raw_opens ~pos with | None -> if Debug.verbose () then @@ -1269,7 +1291,7 @@ and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env match completion_path with | None -> [] | Some (is_from_current_module, completion_path) -> - completions_for_pipe_from_completion_path + completions_for_pipe_from_completion_path ~state ~env_completion_is_made_from ~opens ~pos ~scope ~debug ~prefix ~env ~raw_opens ~full completion_path |> Type_utils.filter_pipeable_functions ~env ~full ~synthetic @@ -1303,7 +1325,7 @@ and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env let globally_configured_completions = globally_configured_completions_for_type |> List.map (fun completion_path -> - completions_for_pipe_from_completion_path + completions_for_pipe_from_completion_path ~state ~env_completion_is_made_from ~opens ~pos ~scope ~debug ~prefix ~env ~raw_opens ~full completion_path) |> List.flatten @@ -1316,7 +1338,7 @@ and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env let extra_completions = Type_utils.get_extra_modules_to_complete_from_for_type ~env ~full typ |> List.map (fun completion_path -> - completions_for_pipe_from_completion_path + completions_for_pipe_from_completion_path ~state ~env_completion_is_made_from ~opens ~pos ~scope ~debug ~prefix ~env ~raw_opens ~full completion_path) |> List.flatten @@ -1332,8 +1354,8 @@ and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env in (* Add completions from the current module. *) let current_module_completions = - get_completions_for_path ~debug ~completion_context:Value ~exact:false - ~opens:[] ~full ~pos ~env:env_at_cursor ~scope [prefix] + get_completions_for_path ~state ~debug ~completion_context:Value + ~exact:false ~opens:[] ~full ~pos ~env:env_at_cursor ~scope [prefix] |> Type_utils.filter_pipeable_functions ~synthetic:true ~env ~full ~target_type_id:main_type_id in @@ -1346,8 +1368,8 @@ and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env ctx_paths |> List.map (fun context_path -> context_path - |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens - ~pos ~env ~exact:true ~scope) + |> get_completions_for_context_path ~state ~debug ~full ~opens + ~raw_opens ~pos ~env ~exact:true ~scope) |> List.filter_map (fun completion_items -> match completion_items with | {Completion.kind = Value typ} :: _ -> Some typ @@ -1363,9 +1385,9 @@ and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env if Debug.verbose () then print_endline "[ctx_path]--> CJsxPropValue"; let find_type_of_value path = path - |> get_completions_for_path ~debug ~completion_context:Value ~exact:true - ~opens ~full ~pos ~env ~scope - |> completions_get_type_env2 ~debug ~full ~opens ~raw_opens ~pos + |> get_completions_for_path ~state ~debug ~completion_context:Value + ~exact:true ~opens ~full ~pos ~env ~scope + |> completions_get_type_env2 ~state ~debug ~full ~opens ~raw_opens ~pos in let lowercase_component = match path_to_component with @@ -1378,7 +1400,7 @@ and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env let rec dig_to_type_for_completion path = match path - |> get_completions_for_path ~debug ~completion_context:Type + |> get_completions_for_path ~state ~debug ~completion_context:Type ~exact:true ~opens ~full ~pos ~env ~scope with | {kind = Type {kind = Abstract (Some (p, _))}} :: _ -> @@ -1440,9 +1462,10 @@ and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env let labels, env = match function_context_path - |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos - ~env ~exact:true ~scope - |> completions_get_completion_type2 ~debug ~full ~opens ~raw_opens ~pos + |> get_completions_for_context_path ~state ~debug ~full ~opens + ~raw_opens ~pos ~env ~exact:true ~scope + |> completions_get_completion_type2 ~state ~debug ~full ~opens + ~raw_opens ~pos with | Some ((TypeExpr typ | ExtractedType (Tfunction {typ})), env) -> if Debug.verbose () then print_endline "--> found function type"; @@ -1487,9 +1510,10 @@ and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env (* TODO(env-stuff) Get rid of innerType etc *) match root_ctx_path - |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos - ~env ~exact:true ~scope - |> completions_get_completion_type2 ~debug ~full ~opens ~raw_opens ~pos + |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens + ~pos ~env ~exact:true ~scope + |> completions_get_completion_type2 ~state ~debug ~full ~opens ~raw_opens + ~pos with | Some (typ, env) -> ( match @@ -1505,7 +1529,7 @@ and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env | None -> [] | Some typ_expr -> [Completion.create "dummy" ~env ~kind:(Value typ_expr)]) -let get_opens ~debug ~raw_opens ~package ~env = +let get_opens ~state ~debug ~raw_opens ~package ~env = if debug && raw_opens <> [] then Printf.printf "%s\n" ("Raw opens: " @@ -1519,7 +1543,7 @@ let get_opens ~debug ~raw_opens ~package ~env = ^ String.concat " " (package_opens |> List.map (fun p -> p |> path_to_string))); let resolved_opens = - resolve_opens ~env (List.rev (raw_opens @ package_opens)) ~package + resolve_opens ~state ~env (List.rev (raw_opens @ package_opens)) ~package in if debug && resolved_opens <> [] then Printf.printf "%s\n" @@ -2005,26 +2029,27 @@ let rec complete_typed_value ?(type_arg_context : type_arg_context option) module String_set = Set.Make (String) -let rec process_completable ~debug ~full ~scope ~env ~pos ~for_hover completable - = +let rec process_completable ?state ~debug ~full ~scope ~env ~pos ~for_hover + completable = + let state = Option.value state ~default:full.package.state in if debug then Printf.printf "Completable: %s\n" (Completable.to_string completable); let package = full.package in let raw_opens = Scope.get_raw_opens scope in - let opens = get_opens ~debug ~raw_opens ~package ~env in + let opens = get_opens ~state ~debug ~raw_opens ~package ~env in let all_files = all_files_in_package package in let find_type_of_value path = path - |> get_completions_for_path ~debug ~completion_context:Value ~exact:true - ~opens ~full ~pos ~env ~scope - |> completions_get_type_env2 ~debug ~full ~opens ~raw_opens ~pos + |> get_completions_for_path ~state ~debug ~completion_context:Value + ~exact:true ~opens ~full ~pos ~env ~scope + |> completions_get_type_env2 ~state ~debug ~full ~opens ~raw_opens ~pos in match completable with | Cnone -> [] | Cpath context_path -> context_path - |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env - ~exact:for_hover ~scope + |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens + ~pos ~env ~exact:for_hover ~scope | Cjsx ([id], prefix, idents_seen) when String.uncapitalize_ascii id = id -> ( (* Lowercase JSX tag means builtin *) let mk_label (name, typ_string) = @@ -2042,8 +2067,8 @@ let rec process_completable ~debug ~full ~scope ~env ~pos ~for_hover completable let from_element_props = match path_to_element_props - |> dig_to_record_fields_for_completion ~debug ~package ~opens ~full ~pos - ~env ~scope + |> dig_to_record_fields_for_completion ~state ~debug ~package ~opens + ~full ~pos ~env ~scope with | None -> None | Some fields -> @@ -2280,9 +2305,9 @@ let rec process_completable ~debug ~full ~scope ~env ~pos ~for_hover completable let labels = match cp - |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos - ~env ~exact:true ~scope - |> completions_get_type_env2 ~debug ~full ~opens ~raw_opens ~pos + |> get_completions_for_context_path ~state ~debug ~full ~opens + ~raw_opens ~pos ~env ~exact:true ~scope + |> completions_get_type_env2 ~state ~debug ~full ~opens ~raw_opens ~pos with | Some (typ, _env) -> if debug then @@ -2310,15 +2335,16 @@ let rec process_completable ~debug ~full ~scope ~env ~pos ~for_hover completable let fallback_or_empty ?items () = match (fallback, items) with | Some fallback, (None | Some []) -> - fallback |> process_completable ~debug ~full ~scope ~env ~pos ~for_hover + fallback + |> process_completable ~state ~debug ~full ~scope ~env ~pos ~for_hover | _, Some items -> items | None, None -> [] in match context_path - |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos - ~env ~exact:true ~scope - |> completions_get_type_env2 ~debug ~full ~opens ~raw_opens ~pos + |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens + ~pos ~env ~exact:true ~scope + |> completions_get_type_env2 ~state ~debug ~full ~opens ~raw_opens ~pos with | Some (typ, env) -> ( match @@ -2367,8 +2393,8 @@ let rec process_completable ~debug ~full ~scope ~env ~pos ~for_hover completable in match context_path - |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos - ~env ~exact:true ~scope + |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens + ~pos ~env ~exact:true ~scope |> completions_get_completion_type ~full with | None -> @@ -2468,8 +2494,8 @@ let rec process_completable ~debug ~full ~scope ~env ~pos ~for_hover completable in let completions_for_context_path = context_path - |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos - ~env ~exact:for_hover ~scope + |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens + ~pos ~env ~exact:for_hover ~scope in completions_for_context_path |> List.map (fun (c : Completion.t) -> diff --git a/analysis/src/create_interface.ml b/analysis/src/create_interface.ml index f74f2e151ea..9805a65e3a5 100644 --- a/analysis/src/create_interface.ml +++ b/analysis/src/create_interface.ml @@ -319,11 +319,11 @@ let print_signature ~extractor ~signature = process_signature ~indent:"" signature; Buffer.contents buf -let command ~path ~cmi_file = +let command ~state ~path ~cmi_file = match Shared.try_read_cmi cmi_file with | Some cmi_info -> (* For reading the config *) - let _ = Cmt.load_full_cmt_from_path ~path in + ignore (Cmt.load_full_cmt_from_path ~state ~path); let extractor = Source_file_extractor.create ~path in print_signature ~extractor ~signature:cmi_info.cmi_sign | None -> "" diff --git a/analysis/src/hover.ml b/analysis/src/hover.ml index f87029695a3..ff131dfdc43 100644 --- a/analysis/src/hover.ml +++ b/analysis/src/hover.ml @@ -34,7 +34,7 @@ let show_module_top_level ~docstring ~is_type ~name in Some (doc ^ full) -let rec show_module ~docstring ~(file : File.t) ~package ~name +let rec show_module ~state ~docstring ~(file : File.t) ~package ~name (declared : Module.t Declared.t option) = match declared with | None -> @@ -48,13 +48,15 @@ let rec show_module ~docstring ~(file : File.t) ~package ~name show_module_top_level ~docstring ~is_type ~name items | Some ({item = Constraint (_moduleItem, module_type_item)} as declared) -> (* show the interface *) - show_module ~docstring ~file ~name ~package + show_module ~state ~docstring ~file ~name ~package (Some {declared with item = module_type_item}) | Some ({item = Ident path} as declared) -> ( - match References.resolve_module_reference ~file ~package declared with + match + References.resolve_module_reference ~state ~file ~package declared + with | None -> Some ("Unable to resolve module reference " ^ Path.name path) - | Some (_, declared) -> show_module ~docstring ~file ~name ~package declared - ) + | Some (_, declared) -> + show_module ~state ~docstring ~file ~name ~package declared) type extracted_type = { name: string; @@ -64,7 +66,8 @@ type extracted_type = { loc: Warnings.loc; } -let find_relevant_types_from_type ~file ~package typ = +let find_relevant_types_from_type ?state ~file ~package typ = + let state = Option.value state ~default:package.state in (* Expand definitions of types mentioned in typ. If typ itself is a record or variant, search its body *) let env = Query_env.from_file file in @@ -74,7 +77,7 @@ let find_relevant_types_from_type ~file ~package typ = let label_declarations_types lds = lds |> List.map (fun (ld : Types.label_declaration) -> ld.ld_type) in - match References.dig_constructor ~env ~package path with + match References.dig_constructor ~state ~env ~package path with | None -> (env, [typ]) | Some (env1, {item = {decl}}) -> ( match decl.type_kind with @@ -99,7 +102,7 @@ let find_relevant_types_from_type ~file ~package typ = | None -> (env, [typ]) in let from_constructor_path ~env path = - match References.dig_constructor ~env ~package path with + match References.dig_constructor ~state ~env ~package path with | None -> None | Some (env, {name = {txt}; extent_loc; item = {decl}}) -> if Utils.is_uncurried_internal path then None @@ -108,8 +111,9 @@ let find_relevant_types_from_type ~file ~package typ = let constructors = Shared.find_type_constructors types_to_search in constructors |> List.filter_map (from_constructor_path ~env:env_to_search) -let expand_types ~file ~package ~supports_markdown_links typ = - match find_relevant_types_from_type typ ~file ~package with +let expand_types ?state ~file ~package ~supports_markdown_links typ = + let state = Option.value state ~default:package.state in + match find_relevant_types_from_type ~state typ ~file ~package with | {decl; path} :: _ when Res_parsetree_viewer.has_inline_record_definition_attribute decl.type_attributes -> @@ -158,10 +162,11 @@ let expand_types ~file ~package ~supports_markdown_links typ = `Default ) (* Produces a hover with relevant types expanded in the main type being hovered. *) -let hover_with_expanded_types ~file ~package ~supports_markdown_links ?docstring - ?constructor typ = +let hover_with_expanded_types ?state ~file ~package ~supports_markdown_links + ?docstring ?constructor typ = + let state = Option.value state ~default:package.state in let expanded_types, expansion_type = - expand_types ~file ~package ~supports_markdown_links typ + expand_types ~state ~file ~package ~supports_markdown_links typ in match expansion_type with | `Default -> @@ -185,7 +190,7 @@ let hover_with_expanded_types ~file ~package ~supports_markdown_links ?docstring (* Leverages autocomplete functionality to produce a hover for a position. This makes it (most often) work with unsaved content. *) -let get_hover_via_completions ~debug ~source ~kind_file ~pos ~for_hover +let get_hover_via_completions ~state ~debug ~source ~kind_file ~pos ~for_hover ~supports_markdown_links ~full = match Completions.get_completions ~debug ~source ~kind_file ~pos ~for_hover ~full @@ -203,36 +208,38 @@ let get_hover_via_completions ~debug ~source ~kind_file ~pos ~for_hover Some (String.concat "\n\n" parts) | {kind = Field _; env; docstring} :: _ -> ( let opens = - Completion_back_end.get_opens ~debug ~raw_opens ~package ~env + Completion_back_end.get_opens ~state ~debug ~raw_opens ~package ~env in match - Completion_back_end.completions_get_type_env2 ~debug ~full ~raw_opens - ~opens ~pos completions + Completion_back_end.completions_get_type_env2 ~state ~debug ~full + ~raw_opens ~opens ~pos completions with | Some (typ, _env) -> let type_string = - hover_with_expanded_types ~file ~package ~docstring + hover_with_expanded_types ~state ~file ~package ~docstring ~supports_markdown_links typ in Some type_string | None -> None) | {env} :: _ -> ( let opens = - Completion_back_end.get_opens ~debug ~raw_opens ~package ~env + Completion_back_end.get_opens ~state ~debug ~raw_opens ~package ~env in match - Completion_back_end.completions_get_type_env2 ~debug ~full ~raw_opens - ~opens ~pos completions + Completion_back_end.completions_get_type_env2 ~state ~debug ~full + ~raw_opens ~opens ~pos completions with | Some (typ, _env) -> let type_string = - hover_with_expanded_types ~file ~package ~supports_markdown_links typ + hover_with_expanded_types ~state ~file ~package + ~supports_markdown_links typ in Some type_string | None -> None) | _ -> None) -let new_hover ~full:{file; package} ~supports_markdown_links loc_item = +let new_hover ?state ~full:{file; package} ~supports_markdown_links loc_item = + let state = Option.value state ~default:package.state in match loc_item.loc_type with | TypeDefinition (name, decl, _stamp) -> ( let type_def = Markdown.code_block (Shared.decl_to_string name decl) in @@ -240,7 +247,7 @@ let new_hover ~full:{file; package} ~supports_markdown_links loc_item = | None -> Some type_def | Some typ -> ( let expanded_types, expansion_type = - expand_types ~file ~package ~supports_markdown_links typ + expand_types ~state ~file ~package ~supports_markdown_links typ in match expansion_type with | `Default -> Some (type_def :: expanded_types |> String.concat "\n") @@ -250,7 +257,7 @@ let new_hover ~full:{file; package} ~supports_markdown_links loc_item = match Stamps.find_module file.stamps stamp with | None -> None | Some md -> ( - match References.resolve_module_reference ~file ~package md with + match References.resolve_module_reference ~state ~file ~package md with | None -> None | Some (file, declared) -> let name, docstring = @@ -258,19 +265,21 @@ let new_hover ~full:{file; package} ~supports_markdown_links loc_item = | Some d -> (d.name.txt, d.docstring) | None -> (file.module_name, file.structure.docstring) in - show_module ~docstring ~name ~file declared ~package)) + show_module ~state ~docstring ~name ~file declared ~package)) | LModule (GlobalReference (module_name, path, tip)) -> ( - match Process_cmt.file_for_module ~package module_name with + match Process_cmt.file_for_module ~state ~package module_name with | None -> None | Some file -> ( let env = Query_env.from_file file in - match References.exported_for_tip ~env ~path ~package ~tip with + match References.exported_for_tip ~state ~env ~path ~package ~tip with | None -> None | Some (_env, _name, stamp) -> ( match Stamps.find_module file.stamps stamp with | None -> None | Some md -> ( - match References.resolve_module_reference ~file ~package md with + match + References.resolve_module_reference ~state ~file ~package md + with | None -> None | Some (file, declared) -> let name, docstring = @@ -278,14 +287,14 @@ let new_hover ~full:{file; package} ~supports_markdown_links loc_item = | Some d -> (d.name.txt, d.docstring) | None -> (file.module_name, file.structure.docstring) in - show_module ~docstring ~name ~file ~package declared)))) + show_module ~state ~docstring ~name ~file ~package declared)))) | LModule NotFound -> None | TopLevelModule name -> ( - match Process_cmt.file_for_module ~package name with + match Process_cmt.file_for_module ~state ~package name with | None -> None | Some file -> - show_module ~docstring:file.structure.docstring ~name:file.module_name - ~file ~package None) + show_module ~state ~docstring:file.structure.docstring + ~name:file.module_name ~file ~package None) | Typed (_, _, Definition (_, (Field _ | Constructor _))) -> None | Constant t -> Some @@ -300,7 +309,7 @@ let new_hover ~full:{file; package} ~supports_markdown_links loc_item = | Const_bigint _ -> "bigint")) | Typed (_, t, loc_kind) -> ( let from_type ?docstring ?constructor typ = - hover_with_expanded_types ~file ~package ~supports_markdown_links + hover_with_expanded_types ~state ~file ~package ~supports_markdown_links ?docstring ?constructor typ in (* Expand first-class modules to the underlying module type signature. *) @@ -309,17 +318,17 @@ let new_hover ~full:{file; package} ~supports_markdown_links loc_item = | Tpackage (path, _lids, _tys) -> ( let env = Query_env.from_file file in match - Resolve_path.resolve_module_from_compiler_path ~env ~package path + Resolve_path.resolve_module_from_compiler_path ~state ~env ~package path with | None -> Some (from_type t) | Some (env_for_module, Some declared) -> let name = Path.name path in - show_module ~docstring:declared.docstring ~name + show_module ~state ~docstring:declared.docstring ~name ~file:env_for_module.file ~package (Some declared) | Some (_, None) -> Some (from_type t)) | _ -> Some - (match References.defined_for_loc ~file ~package loc_kind with + (match References.defined_for_loc ~state ~file ~package loc_kind with | None -> t |> from_type | Some (docstring, res) -> ( match res with diff --git a/analysis/src/packages.ml b/analysis/src/packages.ml index 3a5068f1776..e0644c6a53f 100644 --- a/analysis/src/packages.ml +++ b/analysis/src/packages.ml @@ -33,7 +33,7 @@ let get_re_script_version () = version with Not_found -> default_version) -let new_bs_package ~root_path = +let new_bs_package ~state ~root_path = let rescript_json = Filename.concat root_path "rescript.json" in let parse_raw raw = @@ -173,6 +173,7 @@ let new_bs_package ~root_path = |> List.map (fun path -> path @ ["place holder"]) in { + state; generic_jsx_module; suffix; rescript_version; @@ -206,7 +207,7 @@ let find_root ~uri packages_by_root = in loop (if Sys.is_directory path then path else Filename.dirname path) -let get_package ~uri = +let get_package ~state ~uri = let open Shared_types in if Hashtbl.mem state.root_for_uri uri then Some @@ -223,7 +224,7 @@ let get_package ~uri = (Hashtbl.find state.packages_by_root (Hashtbl.find state.root_for_uri uri)) | Some (`Bs root_path) -> ( - match new_bs_package ~root_path with + match new_bs_package ~state ~root_path with | None -> None | Some package -> Hashtbl.replace state.root_for_uri uri package.root_path; diff --git a/analysis/src/process_cmt.ml b/analysis/src/process_cmt.ml index 24066d80cec..5624077dfa3 100644 --- a/analysis/src/process_cmt.ml +++ b/analysis/src/process_cmt.ml @@ -782,7 +782,7 @@ let file_for_cmt_infos ~module_name ~uri {uri; module_name = cmt_modname; stamps = env.stamps; structure} | _ -> File.create module_name uri -let file_for_cmt ~module_name ~cmt ~uri = +let file_for_cmt ~state ~module_name ~cmt ~uri = match Hashtbl.find_opt state.cmt_cache cmt with | Some file -> Some file | None -> ( @@ -793,13 +793,14 @@ let file_for_cmt ~module_name ~cmt ~uri = Hashtbl.replace state.cmt_cache cmt file; Some file) -let file_for_module module_name ~package = +let file_for_module ?state module_name ~package = + let state = Option.value state ~default:package.state in match Hashtbl.find_opt package.paths_for_module module_name with | Some paths -> let uri = get_uri paths in let cmt = get_cmt_path ~uri paths in Log.log ("fileForModule " ^ show_paths paths); - file_for_cmt ~cmt ~module_name ~uri + file_for_cmt ~state ~cmt ~module_name ~uri | None -> Log.log ("No path for module " ^ module_name); None diff --git a/analysis/src/references.ml b/analysis/src/references.ml index 74d6f7f91aa..5115cdf7815 100644 --- a/analysis/src/references.ml +++ b/analysis/src/references.ml @@ -161,8 +161,8 @@ let get_constructor (file : File.t) stamp name = | Some const -> Some const) | _ -> None) -let exported_for_tip ~env ~path ~package ~(tip : Tip.t) = - match Resolve_path.resolve_path ~env ~path ~package with +let exported_for_tip ~state ~env ~path ~package ~(tip : Tip.t) = + match Resolve_path.resolve_path ~state ~env ~path ~package with | None -> Log.log ("Cannot resolve path " ^ path_to_string path); None @@ -179,7 +179,8 @@ let exported_for_tip ~env ~path ~package ~(tip : Tip.t) = None | Some stamp -> Some (env, name, stamp)) -let defined_for_loc ~file ~package loc_kind = +let defined_for_loc ?state ~file ~package loc_kind = + let state = Option.value state ~default:package.state in let inner ~file stamp (tip : Tip.t) = match tip with | Constructor name -> ( @@ -207,13 +208,13 @@ let defined_for_loc ~file ~package loc_kind = inner ~file stamp tip | GlobalReference (module_name, path, tip) -> ( maybe_log ("Getting global " ^ module_name); - match Process_cmt.file_for_module ~package module_name with + match Process_cmt.file_for_module ~state ~package module_name with | None -> Log.log ("Cannot get module " ^ module_name); None | Some file -> ( let env = Query_env.from_file file in - match exported_for_tip ~env ~path ~package ~tip with + match exported_for_tip ~state ~env ~path ~package ~tip with | None -> None | Some (env, name, stamp) -> ( maybe_log ("Getting for " ^ string_of_int stamp ^ " in " ^ name); @@ -226,7 +227,9 @@ let defined_for_loc ~file ~package loc_kind = Some res))) (** Find alternative declaration: from res in case of interface, or from resi in case of implementation *) -let alternate_declared ~(file : File.t) ~package (declared : _ Declared.t) tip = +let alternate_declared ?state ~(file : File.t) ~package + (declared : _ Declared.t) tip = + let state = Option.value state ~default:package.state in match Hashtbl.find_opt package.paths_for_module file.module_name with | None -> None | Some paths -> ( @@ -235,14 +238,14 @@ let alternate_declared ~(file : File.t) ~package (declared : _ Declared.t) tip = maybe_log ("alternateDeclared for " ^ file.module_name ^ " has both resi and res"); let alternate_uri = if Uri.is_interface file.uri then res else resi in - match Cmt.full_from_uri ~uri:(Uri.from_path alternate_uri) with + match Cmt.full_from_uri ~state ~uri:(Uri.from_path alternate_uri) with | None -> None | Some {file; extra} -> ( let env = Query_env.from_file file in let path = Module_path.to_path declared.module_path declared.name.txt in maybe_log ("find declared for path " ^ path_to_string path); let declared_opt = - match exported_for_tip ~env ~path ~package ~tip with + match exported_for_tip ~state ~env ~path ~package ~tip with | None -> None | Some (_env, _name, stamp) -> declared_for_tip ~stamps:file.stamps stamp tip @@ -255,12 +258,13 @@ let alternate_declared ~(file : File.t) ~package (declared : _ Declared.t) tip = None) -let rec resolve_module_reference ?(paths_seen = []) ~file ~package +let rec resolve_module_reference ?(paths_seen = []) ?state ~file ~package (declared : Module.t Declared.t) = + let state = Option.value state ~default:package.state in match declared.item with | Structure _ -> Some (file, Some declared) | Constraint (_moduleItem, module_type_item) -> - resolve_module_reference ~paths_seen ~file ~package + resolve_module_reference ~paths_seen ~state ~file ~package {declared with item = module_type_item} | Ident path -> ( let env = Query_env.from_file file in @@ -274,11 +278,11 @@ let rec resolve_module_reference ?(paths_seen = []) ~file ~package | None -> None | Some md -> Some (env.file, Some md))) | Global (module_name, path) -> ( - match Process_cmt.file_for_module ~package module_name with + match Process_cmt.file_for_module ~state ~package module_name with | None -> None | Some file -> ( let env = Query_env.from_file file in - match Resolve_path.resolve_path ~env ~package ~path with + match Resolve_path.resolve_path ~state ~env ~package ~path with | None -> None | Some (env, name) -> ( match Exported.find env.exported Exported.Module name with @@ -292,11 +296,11 @@ let rec resolve_module_reference ?(paths_seen = []) ~file ~package | None -> None | Some ({item = Ident path} as md) when not (List.mem path paths_seen) -> (* avoid possible infinite loops *) - resolve_module_reference ~file ~package ~paths_seen:(path :: paths_seen) - md + resolve_module_reference ~state ~file ~package + ~paths_seen:(path :: paths_seen) md | Some md -> Some (file, Some md)) | GlobalMod name -> ( - match Process_cmt.file_for_module ~package name with + match Process_cmt.file_for_module ~state ~package name with | None -> None | Some file -> Some (file, None))) @@ -311,11 +315,12 @@ let validate_loc (loc : Location.t) (backup : Location.t) = else backup else loc -let resolve_module_definition ~(file : File.t) ~package stamp = +let resolve_module_definition ?state ~(file : File.t) ~package stamp = + let state = Option.value state ~default:package.state in match Stamps.find_module file.stamps stamp with | None -> None | Some md -> ( - match resolve_module_reference ~file ~package md with + match resolve_module_reference ~state ~file ~package md with | None -> None | Some (file, declared) -> let loc = @@ -325,7 +330,8 @@ let resolve_module_definition ~(file : File.t) ~package stamp = in Some (file.uri, loc)) -let definition ~file ~package stamp (tip : Tip.t) = +let definition ?state ~file ~package stamp (tip : Tip.t) = + let state = Option.value state ~default:package.state in match tip with | Constructor name -> ( match get_constructor file stamp name with @@ -335,13 +341,13 @@ let definition ~file ~package stamp (tip : Tip.t) = match get_field file stamp name with | None -> None | Some field -> Some (file.uri, field.fname.loc)) - | Module -> resolve_module_definition ~file ~package stamp + | Module -> resolve_module_definition ~state ~file ~package stamp | _ -> ( match declared_for_tip ~stamps:file.stamps stamp tip with | None -> None | Some declared -> let file_impl, declared_impl = - match alternate_declared ~package ~file declared tip with + match alternate_declared ~state ~package ~file declared tip with | Some (file_impl, _extra, declared_impl) when Uri.is_interface file.uri -> (file_impl, declared_impl) @@ -350,12 +356,14 @@ let definition ~file ~package stamp (tip : Tip.t) = let loc = validate_loc declared_impl.name.loc declared_impl.extent_loc in let env = Query_env.from_file file_impl in let uri = - Resolve_path.get_source_uri ~env ~package declared_impl.module_path + Resolve_path.get_source_uri ~state ~env ~package + declared_impl.module_path in maybe_log ("Inner uri " ^ Uri.to_string uri); Some (uri, loc)) -let definition_for_loc_item ~full:{file; package} loc_item = +let definition_for_loc_item ?state ~full:{file; package} loc_item = + let state = Option.value state ~default:package.state in match loc_item.loc_type with | Typed (_, _, Definition (stamp, tip)) -> ( maybe_log @@ -367,7 +375,7 @@ let definition_for_loc_item ~full:{file; package} loc_item = maybe_log ("Declared " ^ declared.name.txt); if declared.is_exported then ( maybe_log ("exported, looking for alternate " ^ file.module_name); - match alternate_declared ~package ~file declared tip with + match alternate_declared ~state ~package ~file declared tip with | None -> None | Some (file, _extra, declared) -> let loc = validate_loc declared.name.loc declared.extent_loc in @@ -388,25 +396,26 @@ let definition_for_loc_item ~full:{file; package} loc_item = | LModule (LocalReference (stamp, tip)) | Typed (_, _, LocalReference (stamp, tip)) -> maybe_log ("Local defn " ^ Tip.to_string tip); - definition ~file ~package stamp tip + definition ~state ~file ~package stamp tip | LModule (GlobalReference (module_name, path, tip)) | Typed (_, _, GlobalReference (module_name, path, tip)) -> ( maybe_log ("Typed GlobalReference moduleName:" ^ module_name ^ " path:" ^ path_to_string path ^ " tip:" ^ Tip.to_string tip); - match Process_cmt.file_for_module ~package module_name with + match Process_cmt.file_for_module ~state ~package module_name with | None -> None | Some file -> ( let env = Query_env.from_file file in - match exported_for_tip ~env ~path ~package ~tip with + match exported_for_tip ~state ~env ~path ~package ~tip with | None -> None | Some (env, _name, stamp) -> (* oooh wht do I do if the stamp is inside a pseudo-file? *) maybe_log ("Got stamp " ^ string_of_int stamp); - definition ~file:env.file ~package stamp tip)) + definition ~state ~file:env.file ~package stamp tip)) -let dig_constructor ~env ~package path = - match Resolve_path.resolve_from_compiler_path ~env ~package path with +let dig_constructor ?state ~env ~package path = + let state = Option.value state ~default:package.state in + match Resolve_path.resolve_from_compiler_path ~state ~env ~package path with | NotFound -> None | Stamp stamp -> ( match Stamps.find_type env.file.stamps stamp with @@ -421,7 +430,8 @@ let dig_constructor ~env ~package path = | Some t -> Some (env, t))) | _ -> None -let type_definition_for_loc_item ~full:{file; package} loc_item = +let type_definition_for_loc_item ?state ~full:{file; package} loc_item = + let state = Option.value state ~default:package.state in match loc_item.loc_type with | Constant _ | TopLevelModule _ | LModule _ -> None | TypeDefinition _ -> Some (file.uri, loc_item.loc) @@ -430,7 +440,7 @@ let type_definition_for_loc_item ~full:{file; package} loc_item = match Shared.dig_constructor typ with | None -> None | Some path -> ( - match dig_constructor ~env ~package path with + match dig_constructor ~state ~env ~package path with | Some (env, declared) -> Some (env.file.uri, declared.item.decl.type_loc) | None -> None)) @@ -451,7 +461,8 @@ type references = { loc_opt: Location.t option; (* None: reference to a toplevel module *) } -let for_local_stamp ~full:{file; extra; package} stamp (tip : Tip.t) = +let for_local_stamp ?state ~full:{file; extra; package} stamp (tip : Tip.t) = + let state = Option.value state ~default:package.state in let env = Query_env.from_file file in match match tip with @@ -473,7 +484,7 @@ let for_local_stamp ~full:{file; extra; package} stamp (tip : Tip.t) = | Some declared -> if is_visible declared then ( let alternative_references = - match alternate_declared ~package ~file declared tip with + match alternate_declared ~state ~package ~file declared tip with | None -> [] | Some (file, extra, {stamp}) -> ( match @@ -511,7 +522,7 @@ let for_local_stamp ~full:{file; extra; package} stamp (tip : Tip.t) = package.project_files |> File_set.elements |> List.filter (fun name -> name <> file.module_name) |> List.map (fun module_name -> - Cmt.fulls_from_module ~package ~module_name + Cmt.fulls_from_module ~state ~package ~module_name |> List.map (fun {file; extra} -> match Hashtbl.find_opt extra.external_references @@ -540,13 +551,15 @@ let for_local_stamp ~full:{file; extra; package} stamp (tip : Tip.t) = (locs |> List.map (fun loc -> {uri = file.uri; loc_opt = Some loc})) externals) -let all_references_for_loc_item ~full:({file; package} as full) loc_item = +let all_references_for_loc_item ?state ~full:({file; package} as full) loc_item + = + let state = Option.value state ~default:package.state in match loc_item.loc_type with | TopLevelModule module_name -> let other_modules_references = package.project_files |> File_set.elements |> Utils.filter_map (fun module_name -> - Cmt.full_from_module ~package ~module_name) + Cmt.full_from_module ~state ~package ~module_name) |> List.map (fun full -> match Hashtbl.find_opt full.extra.file_references module_name with | None -> [] @@ -568,24 +581,24 @@ let all_references_for_loc_item ~full:({file; package} as full) loc_item = in List.append target_module_references other_modules_references | Typed (_, _, NotFound) | LModule NotFound | Constant _ -> [] - | TypeDefinition (_, _, stamp) -> for_local_stamp ~full stamp Type + | TypeDefinition (_, _, stamp) -> for_local_stamp ~state ~full stamp Type | Typed (_, _, (LocalReference (stamp, tip) | Definition (stamp, tip))) | LModule (LocalReference (stamp, tip) | Definition (stamp, tip)) -> maybe_log ("Finding references for " ^ Uri.to_string file.uri ^ " and stamp " ^ string_of_int stamp ^ " and tip " ^ Tip.to_string tip); - for_local_stamp ~full stamp tip + for_local_stamp ~state ~full stamp tip | LModule (GlobalReference (module_name, path, tip)) | Typed (_, _, GlobalReference (module_name, path, tip)) -> ( - match Process_cmt.file_for_module ~package module_name with + match Process_cmt.file_for_module ~state ~package module_name with | None -> [] | Some file -> ( let env = Query_env.from_file file in - match exported_for_tip ~env ~path ~package ~tip with + match exported_for_tip ~state ~env ~path ~package ~tip with | None -> [] | Some (env, _name, stamp) -> ( match - Cmt.full_from_module ~package ~module_name:env.file.module_name + Cmt.full_from_module ~state ~package ~module_name:env.file.module_name with | None -> [] | Some full -> @@ -593,4 +606,4 @@ let all_references_for_loc_item ~full:({file; package} as full) loc_item = ("Finding references for (global) " ^ Uri.to_string env.file.uri ^ " and stamp " ^ string_of_int stamp ^ " and tip " ^ Tip.to_string tip); - for_local_stamp ~full stamp tip))) + for_local_stamp ~state ~full stamp tip))) diff --git a/analysis/src/resolve_path.ml b/analysis/src/resolve_path.ml index 9393269359a..7d176bf8696 100644 --- a/analysis/src/resolve_path.ml +++ b/analysis/src/resolve_path.ml @@ -58,7 +58,7 @@ and find_in_module ~(env : Query_env.t) module_ path = | None -> None | Some {item} -> find_in_module ~env item full_path) -let rec resolve_path ~env ~path ~package = +let rec resolve_path ~state ~env ~path ~package = Log.log ("resolvePath path:" ^ path_to_string path); match resolve_path_inner ~env ~path with | None -> None @@ -69,10 +69,11 @@ let rec resolve_path ~env ~path ~package = Log.log ("resolvePath Global path:" ^ path_to_string full_path ^ " module:" ^ module_name); - match Process_cmt.file_for_module ~package module_name with + match Process_cmt.file_for_module ~state ~package module_name with | None -> None | Some file -> - resolve_path ~env:(Query_env.from_file file) ~path:full_path ~package)) + resolve_path ~state ~env:(Query_env.from_file file) ~path:full_path + ~package)) let from_compiler_path ~(env : Query_env.t) path : resolution = match make_path ~env path with @@ -82,14 +83,14 @@ let from_compiler_path ~(env : Query_env.t) path : resolution = | Exported (env, name) -> Exported (env, name) | Global (module_name, full_path) -> Global (module_name, full_path) -let resolve_module_from_compiler_path ~env ~package path = +let resolve_module_from_compiler_path ~state ~env ~package path = match from_compiler_path ~env path with | Global (module_name, path) -> ( - match Process_cmt.file_for_module ~package module_name with + match Process_cmt.file_for_module ~state ~package module_name with | None -> None | Some file -> ( let env = Query_env.from_file file in - match resolve_path ~env ~package ~path with + match resolve_path ~state ~env ~package ~path with | None -> None | Some (env, name) -> ( match Exported.find env.exported Exported.Module name with @@ -103,7 +104,7 @@ let resolve_module_from_compiler_path ~env ~package path = | None -> None | Some declared -> Some (env, Some declared)) | GlobalMod module_name -> ( - match Process_cmt.file_for_module ~package module_name with + match Process_cmt.file_for_module ~state ~package module_name with | None -> None | Some file -> let env = Query_env.from_file file in @@ -117,15 +118,15 @@ let resolve_module_from_compiler_path ~env ~package path = | None -> None | Some declared -> Some (env, Some declared))) -let resolve_from_compiler_path ~env ~package path = +let resolve_from_compiler_path ~state ~env ~package path = match from_compiler_path ~env path with | Global (module_name, path) -> ( let res = - match Process_cmt.file_for_module ~package module_name with + match Process_cmt.file_for_module ~state ~package module_name with | None -> None | Some file -> let env = Query_env.from_file file in - resolve_path ~env ~package ~path + resolve_path ~state ~env ~package ~path in match res with | None -> NotFound @@ -135,15 +136,17 @@ let resolve_from_compiler_path ~env ~package path = | NotFound -> NotFound | Exported (env, name) -> Exported (env, name) -let rec get_source_uri ~(env : Query_env.t) ~package (path : Module_path.t) = +let rec get_source_uri ~state ~(env : Query_env.t) ~package + (path : Module_path.t) = match path with | File (uri, _moduleName) -> uri | NotVisible -> env.file.uri | IncludedModule (path, inner) -> ( Log.log "INCLUDED MODULE"; - match resolve_module_from_compiler_path ~env ~package path with + match resolve_module_from_compiler_path ~state ~env ~package path with | None -> Log.log "NOT FOUND"; - get_source_uri ~env ~package inner + get_source_uri ~state ~env ~package inner | Some (env, _declared) -> env.file.uri) - | ExportedModule {module_path = inner} -> get_source_uri ~env ~package inner + | ExportedModule {module_path = inner} -> + get_source_uri ~state ~env ~package inner diff --git a/analysis/src/shared_types.ml b/analysis/src/shared_types.ml index 7685e8cd5b8..285ae93523b 100644 --- a/analysis/src/shared_types.ml +++ b/analysis/src/shared_types.ml @@ -519,7 +519,14 @@ type file = string module File_set = Set.Make (String) -type package = { +type state = { + packages_by_root: (string, package) Hashtbl.t; + root_for_uri: (Uri.t, string) Hashtbl.t; + cmt_cache: (file_path, File.t) Hashtbl.t; +} + +and package = { + state: state; generic_jsx_module: string option; suffix: string; root_path: file_path; @@ -545,14 +552,7 @@ let init_extra () = loc_items = []; } -type state = { - packages_by_root: (string, package) Hashtbl.t; - root_for_uri: (Uri.t, string) Hashtbl.t; - cmt_cache: (file_path, File.t) Hashtbl.t; -} - -(* There's only one state, so it can as well be global *) -let state = +let create_state () = { packages_by_root = Hashtbl.create 1; root_for_uri = Hashtbl.create 30; diff --git a/analysis/src/xform.ml b/analysis/src/xform.ml index 8b78dee94b9..4667d464cba 100644 --- a/analysis/src/xform.ml +++ b/analysis/src/xform.ml @@ -2,7 +2,7 @@ let is_braced_expr = Res_parsetree_viewer.is_braced_expr -let extract_type_from_expr expr ~debug ~source ~kind_file ~full ~pos = +let extract_type_from_expr ~state expr ~debug ~source ~kind_file ~full ~pos = match expr.Parsetree.pexp_loc |> Completion_front_end.find_type_of_expression_at_loc ~debug ~source @@ -13,18 +13,18 @@ let extract_type_from_expr expr ~debug ~source ~kind_file ~full ~pos = let env = Shared_types.Query_env.from_file full.Shared_types.file in let completions = completable - |> Completion_back_end.process_completable ~debug ~full ~pos ~scope ~env - ~for_hover:true + |> Completion_back_end.process_completable ~state ~debug ~full ~pos ~scope + ~env ~for_hover:true in let raw_opens = Scope.get_raw_opens scope in match completions with | {env} :: _ -> ( let opens = - Completion_back_end.get_opens ~debug ~raw_opens ~package:full.package - ~env + Completion_back_end.get_opens ~state ~debug ~raw_opens + ~package:full.package ~env in match - Completion_back_end.completions_get_completion_type2 ~debug ~full + Completion_back_end.completions_get_completion_type2 ~state ~debug ~full ~raw_opens ~opens ~pos completions with | Some (typ, _env) -> @@ -385,8 +385,8 @@ module Expand_catch_all_for_variants = struct in {Ast_iterator.default_iterator with expr} - let xform ~source ~kind_file ~path ~pos ~full ~structure ~code_actions ~debug - = + let xform ~state ~source ~kind_file ~path ~pos ~full ~structure ~code_actions + ~debug = let result = ref None in let iterator = mk_iterator ~pos ~result in iterator.structure iterator structure; @@ -421,7 +421,7 @@ module Expand_catch_all_for_variants = struct let current_constructor_names = get_current_constructor_names cases in match switch_expr - |> extract_type_from_expr ~debug ~source ~kind_file ~full + |> extract_type_from_expr ~state ~debug ~source ~kind_file ~full ~pos:(Pos.of_lexing switch_expr.pexp_loc.loc_end) with | Some (Tvariant {constructors}) -> @@ -592,7 +592,7 @@ module Exhaustive_switch = struct in {Ast_iterator.default_iterator with expr} - let xform ~print_expr ~path ~source ~kind_file ~pos ~full ~structure + let xform ~state ~print_expr ~path ~source ~kind_file ~pos ~full ~structure ~code_actions ~debug = (* TODO: Adapt to '(' as leading/trailing character (skip one col, it's not included in the AST) *) let result = ref None in @@ -617,7 +617,7 @@ module Exhaustive_switch = struct | Some (Selection {expr}) -> ( match expr - |> extract_type_from_expr ~debug ~source ~kind_file ~full + |> extract_type_from_expr ~state ~debug ~source ~kind_file ~full ~pos:(Pos.of_lexing expr.pexp_loc.loc_start) with | None -> () @@ -643,7 +643,7 @@ module Exhaustive_switch = struct | Some (Switch {switch_expr; completion_expr; pos}) -> ( match completion_expr - |> extract_type_from_expr ~debug ~source ~kind_file ~full ~pos + |> extract_type_from_expr ~state ~debug ~source ~kind_file ~full ~pos with | None -> () | Some extracted_type -> ( @@ -912,7 +912,8 @@ let parse_interface ~source = in (structure, print_signature_item) -let extract_code_actions ~path ~start_pos ~end_pos ~source ~kind_file ~debug = +let extract_code_actions ~state ~path ~start_pos ~end_pos ~source ~kind_file + ~debug = let pos = start_pos in let code_actions = ref [] in match kind_file with @@ -931,13 +932,13 @@ let extract_code_actions ~path ~start_pos ~end_pos ~source ~kind_file ~debug = (* This Code Action needs type info *) let () = - match Cmt.load_full_cmt_from_path ~path with + match Cmt.load_full_cmt_from_path ~state ~path with | Some full -> Add_type_annotation.xform ~path ~pos ~full ~structure ~code_actions ~debug; - Expand_catch_all_for_variants.xform ~path ~source ~kind_file ~pos ~full - ~structure ~code_actions ~debug; - Exhaustive_switch.xform ~print_expr ~path ~source ~kind_file + Expand_catch_all_for_variants.xform ~state ~path ~source ~kind_file ~pos + ~full ~structure ~code_actions ~debug; + Exhaustive_switch.xform ~state ~print_expr ~path ~source ~kind_file ~pos: (if start_pos = end_pos then Single start_pos else Range (start_pos, end_pos)) diff --git a/tools/bin/main.ml b/tools/bin/main.ml index bf4df8cecd4..b939414e6c4 100644 --- a/tools/bin/main.ml +++ b/tools/bin/main.ml @@ -82,7 +82,8 @@ let main () = let root_path = if Filename.is_relative root then Unix.realpath root else root in - match Analysis.Packages.new_bs_package ~root_path with + let state = Analysis.Shared_types.create_state () in + match Analysis.Packages.new_bs_package ~state ~root_path with | None -> log_and_exit (Error diff --git a/tools/src/migrate.ml b/tools/src/migrate.ml index 30bba2094f7..bfbb9f38783 100644 --- a/tools/src/migrate.ml +++ b/tools/src/migrate.ml @@ -745,13 +745,14 @@ let migrate ~entry_point_file ~output_mode = | true -> Unix.realpath entry_point_file | false -> entry_point_file in + let state = Shared_types.create_state () in let result = if Filename.check_suffix path ".res" then let parser = Res_driver.parsing_engine.parse_implementation ~for_printer:true in let {Res_driver.parsetree; comments; source} = parser ~filename:path in - match Cmt.load_cmt_infos_from_path ~path with + match Cmt.load_cmt_infos_from_path ~state ~path with | None -> Error (Printf.sprintf @@ -784,7 +785,7 @@ let migrate ~entry_point_file ~output_mode = parser ~filename:path in - match Cmt.load_cmt_infos_from_path ~path with + match Cmt.load_cmt_infos_from_path ~state ~path with | None -> Error (Printf.sprintf diff --git a/tools/src/tools.ml b/tools/src/tools.ml index 521d3f833f4..0da1e6f1a71 100644 --- a/tools/src/tools.ml +++ b/tools/src/tools.ml @@ -379,6 +379,7 @@ let extract_docs ~entry_point_file ~debug = | true -> Unix.realpath entry_point_file | false -> entry_point_file in + let state = Shared_types.create_state () in if debug then Printf.printf "extracting docs for %s\n" path; let result = match @@ -401,7 +402,7 @@ let extract_docs ~entry_point_file ~debug = else path else path in - match Cmt.load_full_cmt_from_path ~path with + match Cmt.load_full_cmt_from_path ~state ~path with | None -> Error (Printf.sprintf @@ -1003,6 +1004,7 @@ module Extract_codeblocks = struct let extract_code_blocks ~entry_point_file ~(process_docstrings : id:string -> name:string -> string -> unit) = + let state = Shared_types.create_state () in let path = match Filename.is_relative entry_point_file with | true -> Unix.realpath entry_point_file @@ -1024,7 +1026,7 @@ module Extract_codeblocks = struct if Sys.file_exists path_as_resi then path_as_resi else path else path in - match Cmt.load_full_cmt_from_path ~path with + match Cmt.load_full_cmt_from_path ~state ~path with | None -> Error (Printf.sprintf From b63a60f313b1b42f204015558d55523ddc7f2f86 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sun, 7 Jun 2026 17:12:01 -0300 Subject: [PATCH 32/37] lsp: use analysis state --- lsp/src/rescript_language_server.ml | 79 ++++++++++++++--------------- lsp/src/state.ml | 16 ++++-- 2 files changed, 50 insertions(+), 45 deletions(-) diff --git a/lsp/src/rescript_language_server.ml b/lsp/src/rescript_language_server.ml index 7df1dbc77ed..1d8cf5e46a2 100644 --- a/lsp/src/rescript_language_server.ml +++ b/lsp/src/rescript_language_server.ml @@ -95,6 +95,11 @@ let on_initialize (params : InitializeParams.t) (server : State.t Server.t) = let on_request (Client_request.E request) (server : State.t Server.t) = let state = Server.state server in + let analysis_state = state.analysis_state in + let load_full uri = + Analysis.Cmt.load_full_cmt_from_path ~state:analysis_state + ~path:(DocumentUri.to_path uri) + in let ok value = Ok (Client_request.yojson_of_result request value) in match request with @@ -103,11 +108,10 @@ let on_request (Client_request.E request) (server : State.t Server.t) = (ok initialization_info, state) | TextDocumentHover {position; textDocument = {uri}} -> let source = (Document_store.get ~uri state.store).text in - let full = - Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) - in + let full = load_full uri in let hover = - Analysis.Commands.hover ~source ~kind_file:(Document.kind uri) + Analysis.Commands.hover ~state:analysis_state ~source + ~kind_file:(Document.kind uri) ~pos:(position.line, position.character) ~debug:false (* TODO: supports_markdown_links should be get from client capabilities *) @@ -116,11 +120,9 @@ let on_request (Client_request.E request) (server : State.t Server.t) = (ok hover, state) | TextDocumentCompletion {textDocument = {uri}; position} -> let source = (Document_store.get ~uri state.store).text in - let full = - Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) - in + let full = load_full uri in let comp = - Analysis.Commands.completion ~debug:false ~source + Analysis.Commands.completion ~state:analysis_state ~debug:false ~source ~kind_file:(Document.kind uri) ~pos:(position.line, position.character) ~full @@ -138,9 +140,13 @@ let on_request (Client_request.E request) (server : State.t Server.t) = let module_path = List.assoc_opt "modulePath" fields in match (file_path, module_path) with | Some (`String file_path), Some (`String module_path) -> - let full = Analysis.Cmt.load_full_cmt_from_path ~path:file_path in + let full = + Analysis.Cmt.load_full_cmt_from_path ~state:analysis_state + ~path:file_path + in let documentation = - Analysis.Commands.completion_resolve ~full ~module_path + Analysis.Commands.completion_resolve ~state:analysis_state ~full + ~module_path in Some {item with documentation} | _ -> None) @@ -150,12 +156,11 @@ let on_request (Client_request.E request) (server : State.t Server.t) = (ok (resp |> Option.value ~default:item), state) | SignatureHelp {textDocument = {uri}; position} -> let source = (Document_store.get ~uri state.store).text in - let full = - Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) - in + let full = load_full uri in let resp = match - Analysis.Commands.signature_help ~source ~kind_file:(Document.kind uri) + Analysis.Commands.signature_help ~state:analysis_state ~source + ~kind_file:(Document.kind uri) ~pos:(position.line, position.character) ~full ~allow_for_constructor_payloads:true ~debug:false with @@ -164,12 +169,10 @@ let on_request (Client_request.E request) (server : State.t Server.t) = in (ok resp, state) | TextDocumentDefinition {textDocument = {uri}; position} -> - let full = - Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) - in + let full = load_full uri in let resp = match - Analysis.Commands.definition ~full + Analysis.Commands.definition ~state:analysis_state ~full ~pos:(position.line, position.character) ~debug:false with @@ -178,12 +181,10 @@ let on_request (Client_request.E request) (server : State.t Server.t) = in (ok resp, state) | TextDocumentTypeDefinition {textDocument = {uri}; position} -> - let full = - Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) - in + let full = load_full uri in let resp = match - Analysis.Commands.type_definition ~full + Analysis.Commands.type_definition ~state:analysis_state ~full ~pos:(position.line, position.character) ~debug:false with @@ -192,11 +193,9 @@ let on_request (Client_request.E request) (server : State.t Server.t) = in (ok resp, state) | TextDocumentReferences {textDocument = {uri}; position} -> - let full = - Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) - in + let full = load_full uri in let resp = - Analysis.Commands.references ~full + Analysis.Commands.references ~state:analysis_state ~full ~pos:(position.line, position.character) ~debug:false in @@ -214,7 +213,8 @@ let on_request (Client_request.E request) (server : State.t Server.t) = | CodeAction {textDocument = {uri}; range = {start; end_}} -> let source = (Document_store.get ~uri state.store).text in let resp = - Analysis.Xform.extract_code_actions ~path:(Uri.to_path uri) + Analysis.Xform.extract_code_actions ~state:analysis_state + ~path:(Uri.to_path uri) ~start_pos:(start.line, start.character) ~end_pos:(end_.line, end_.character) ~source ~kind_file:(Document.kind uri) ~debug:false @@ -223,9 +223,7 @@ let on_request (Client_request.E request) (server : State.t Server.t) = (ok (Some resp), state) | TextDocumentCodeLens {textDocument = {uri}} -> let source = (Document_store.get ~uri state.store).text in - let full = - Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) - in + let full = load_full uri in let resp = Analysis.Hint.code_lens ~source ~kind_file:(Document.kind uri) ~full ~debug:false @@ -233,9 +231,7 @@ let on_request (Client_request.E request) (server : State.t Server.t) = (ok (resp |> Option.value ~default:[]), state) | InlayHint {textDocument = {uri}; range = {start; end_}} -> let source = (Document_store.get ~uri state.store).text in - let full = - Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) - in + let full = load_full uri in let resp = Analysis.Hint.inlay ~source ~kind_file:(Document.kind uri) ~full ~pos:(start.line, end_.line) (* TODO: max_length should be a config *) @@ -250,12 +246,10 @@ let on_request (Client_request.E request) (server : State.t Server.t) = in (ok (Some resp), state) | TextDocumentRename {textDocument = {uri}; position; newName} -> - let full = - Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) - in + let full = load_full uri in let resp = match - Analysis.Commands.rename ~full + Analysis.Commands.rename ~state:analysis_state ~full ~pos:(position.line, position.character) ~new_name:newName ~debug:false with @@ -264,12 +258,10 @@ let on_request (Client_request.E request) (server : State.t Server.t) = in (ok resp, state) | TextDocumentPrepareRename {textDocument = {uri}; position} -> - let full = - Analysis.Cmt.load_full_cmt_from_path ~path:(DocumentUri.to_path uri) - in + let full = load_full uri in let resp = match - Analysis.Commands.prepare_rename ~full + Analysis.Commands.prepare_rename ~state:analysis_state ~full ~pos:(position.line, position.character) ~debug:false with @@ -281,7 +273,10 @@ let on_request (Client_request.E request) (server : State.t Server.t) = let source = (Document_store.get ~uri state.store).text in let resp = - match Analysis.Commands.format ~source ~kind_file:(Document.kind uri) with + match + Analysis.Commands.format ~state:analysis_state ~source + ~kind_file:(Document.kind uri) + with | Ok text_edit -> Some text_edit | Error _ -> None in diff --git a/lsp/src/state.ml b/lsp/src/state.ml index d5b1a3094aa..6098515bf5e 100644 --- a/lsp/src/state.ml +++ b/lsp/src/state.ml @@ -4,10 +4,20 @@ type status = | Uninitialized | Initialized of {params: InitializeParams.t; diagnostics: Diagnostics.t} -(* TODO: add trace, configuration *) -type t = {status: status; store: Document_store.t; fs: Eio.Fs.dir_ty Eio.Path.t} +type t = { + status: status; + store: Document_store.t; + fs: Eio.Fs.dir_ty Eio.Path.t; + analysis_state: Analysis.Shared_types.state; +} -let create ~store ~fs = {status = Uninitialized; store; fs} +let create ~store ~fs = + { + status = Uninitialized; + store; + fs; + analysis_state = Analysis.Shared_types.create_state (); + } let initialize t ~params ~diagnostics = {t with status = Initialized {params; diagnostics}} From 88190b961141392ab3e8ed381b5582ab7186bf68 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Mon, 8 Jun 2026 12:19:54 -0300 Subject: [PATCH 33/37] Revert "analysis refactor: remove global state `Shared_types.state`" This reverts commit bbcb7b9388c5a577fa1fa71f5feabe881db1f978. --- analysis/bin/main.ml | 41 ++--- analysis/src/cli.ml | 104 +++++------ analysis/src/cmt.ml | 16 +- analysis/src/cmt_viewer.ml | 4 +- analysis/src/commands.ml | 45 +++-- analysis/src/completion_back_end.ml | 270 +++++++++++++--------------- analysis/src/create_interface.ml | 4 +- analysis/src/hover.ml | 83 ++++----- analysis/src/packages.ml | 7 +- analysis/src/process_cmt.ml | 7 +- analysis/src/references.ml | 97 +++++----- analysis/src/resolve_path.ml | 31 ++-- analysis/src/shared_types.ml | 18 +- analysis/src/xform.ml | 35 ++-- tools/bin/main.ml | 3 +- tools/src/migrate.ml | 5 +- tools/src/tools.ml | 6 +- 17 files changed, 353 insertions(+), 423 deletions(-) diff --git a/analysis/bin/main.ml b/analysis/bin/main.ml index 5594e2b6684..f57103378be 100644 --- a/analysis/bin/main.ml +++ b/analysis/bin/main.ml @@ -92,7 +92,6 @@ Options: |} let main () = - let state = Shared_types.create_state () in let args = Array.to_list Sys.argv in let debug_level, args = match args with @@ -119,7 +118,7 @@ let main () = | [_; "cache-project"; root_path] -> ( Cfg.read_project_config_cache := false; let uri = Uri.from_path root_path in - match Packages.get_package ~state ~uri with + match Packages.get_package ~uri with | Some package -> Cache.cache_project package | None -> print_endline "\"ERR\"") | [_; "cache-delete"; root_path] -> ( @@ -137,20 +136,18 @@ let main () = print_header_info path line col; Cli.completion ~debug ~path ~pos:(int_of_string line, int_of_string col) - ~current_file ~state + ~current_file | [_; "completionResolve"; path; module_path] -> - Cli.completion_resolve ~state ~path ~module_path + Cli.completion_resolve ~path ~module_path | [_; "definition"; path; line; col] -> - Cli.definition ~state ~path - ~pos:(int_of_string line, int_of_string col) - ~debug + Cli.definition ~path ~pos:(int_of_string line, int_of_string col) ~debug | [_; "typeDefinition"; path; line; col] -> - Cli.type_definition ~state ~path + Cli.type_definition ~path ~pos:(int_of_string line, int_of_string col) ~debug | [_; "documentSymbol"; path] -> Cli.document_symbol ~path | [_; "hover"; path; line; col; current_file; supports_markdown_links] -> - Cli.hover ~state ~path + Cli.hover ~path ~pos:(int_of_string line, int_of_string col) ~current_file ~debug ~supports_markdown_links: @@ -166,7 +163,7 @@ let main () = current_file; allow_for_constructor_payloads; ] -> - Cli.signature_help ~state ~path + Cli.signature_help ~path ~pos:(int_of_string line, int_of_string col) ~current_file ~debug ~allow_for_constructor_payloads: @@ -174,14 +171,14 @@ let main () = | "true" -> true | _ -> false) | [_; "inlayHint"; path; line_start; line_end; max_length] -> - Cli.inlayhint ~state ~path + Cli.inlayhint ~path ~pos:(int_of_string line_start, int_of_string line_end) ~max_length ~debug - | [_; "codeLens"; path] -> Cli.code_lens ~state ~path ~debug + | [_; "codeLens"; path] -> Cli.code_lens ~path ~debug | [ _; "codeAction"; path; start_line; start_col; end_line; end_col; current_file; ] -> - Cli.code_action ~state ~path + Cli.code_action ~path ~start_pos:(int_of_string start_line, int_of_string start_col) ~end_pos:(int_of_string end_line, int_of_string end_col) ~current_file ~debug @@ -200,27 +197,23 @@ let main () = |> print_endline | [_; "diagnosticSyntax"; path] -> Cli.diagnostic_syntax ~path | [_; "references"; path; line; col] -> - Cli.references ~state ~path - ~pos:(int_of_string line, int_of_string col) - ~debug + Cli.references ~path ~pos:(int_of_string line, int_of_string col) ~debug | [_; "prepareRename"; path; line; col] -> - Cli.prepare_rename ~state ~path - ~pos:(int_of_string line, int_of_string col) - ~debug + Cli.prepare_rename ~path ~pos:(int_of_string line, int_of_string col) ~debug | [_; "rename"; path; line; col; new_name] -> - Cli.rename ~state ~path + Cli.rename ~path ~pos:(int_of_string line, int_of_string col) ~new_name ~debug | [_; "semanticTokens"; current_file] -> Cli.semantic_tokens ~path:current_file | [_; "createInterface"; path; cmi_file] -> - `String (Create_interface.command ~state ~path ~cmi_file) + `String (Create_interface.command ~path ~cmi_file) |> Yojson.Safe.pretty_to_string ~std:true |> print_endline - | [_; "format"; path] -> Cli.format ~state ~path - | [_; "test"; path] -> Cli.test ~state ~path + | [_; "format"; path] -> Cli.format ~path + | [_; "test"; path] -> Cli.test ~path | [_; "cmt"; rescript_json; cmt_path] -> - Cmt_viewer.dump ~state rescript_json cmt_path + Cmt_viewer.dump rescript_json cmt_path | args when List.mem "-h" args || List.mem "--help" args -> prerr_endline help | _ -> prerr_endline help; diff --git a/analysis/src/cli.ml b/analysis/src/cli.ml index 5801f2f5ff4..78d6c86a5f8 100644 --- a/analysis/src/cli.ml +++ b/analysis/src/cli.ml @@ -3,24 +3,24 @@ let print_string json = let print_null () = `Null |> print_string let print_list l = `List l |> print_string -let completion ~state ~debug ~path ~pos ~current_file = - let full = Cmt.load_full_cmt_from_path ~state ~path in +let completion ~debug ~path ~pos ~current_file = + let full = Cmt.load_full_cmt_from_path ~path in let kind_file = Files.classify_source_file current_file in match Files.read_file current_file with | None | Some "" -> print_null () | Some source -> - Commands.completion ~state ~debug ~source ~kind_file ~pos ~full + Commands.completion ~debug ~source ~kind_file ~pos ~full |> List.map (fun c -> Lsp.Types.CompletionItem.yojson_of_t c) |> print_list -let completion_resolve ~state ~path ~module_path = - let full = Cmt.load_full_cmt_from_path ~state ~path in - match Commands.completion_resolve ~state ~full ~module_path with +let completion_resolve ~path ~module_path = + let full = Cmt.load_full_cmt_from_path ~path in + match Commands.completion_resolve ~full ~module_path with | None -> print_null () | Some (`MarkupContent {value}) -> `String value |> print_string -let inlayhint ~state ~path ~pos ~max_length ~debug = - let full = Cmt.load_full_cmt_from_path ~state ~path in +let inlayhint ~path ~pos ~max_length ~debug = + let full = Cmt.load_full_cmt_from_path ~path in let kind_file = Files.classify_source_file path in match Files.read_file path with | None -> print_null () @@ -32,8 +32,8 @@ let inlayhint ~state ~path ~pos ~max_length ~debug = |> print_list | None -> print_null ()) -let code_lens ~state ~path ~debug = - let full = Cmt.load_full_cmt_from_path ~state ~path in +let code_lens ~path ~debug = + let full = Cmt.load_full_cmt_from_path ~path in let kind_file = Files.classify_source_file path in match Files.read_file path with | None -> print_null () @@ -43,68 +43,68 @@ let code_lens ~state ~path ~debug = lens |> List.map (fun l -> Lsp.Types.CodeLens.yojson_of_t l) |> print_list | None -> print_null ()) -let hover ~state ~path ~pos ~current_file ~debug ~supports_markdown_links = - let full = Cmt.load_full_cmt_from_path ~state ~path in +let hover ~path ~pos ~current_file ~debug ~supports_markdown_links = + let full = Cmt.load_full_cmt_from_path ~path in let kind_file = Files.classify_source_file current_file in match Files.read_file current_file with | None -> print_null () | Some source -> ( match Commands.hover ~source ~kind_file ~pos ~debug ~supports_markdown_links - ~state ~full + ~full with | Some value -> Lsp.Types.Hover.yojson_of_t value |> print_string | None -> print_null ()) -let signature_help ~state ~path ~pos ~current_file ~debug +let signature_help ~path ~pos ~current_file ~debug ~allow_for_constructor_payloads = - let full = Cmt.load_full_cmt_from_path ~state ~path in + let full = Cmt.load_full_cmt_from_path ~path in let kind_file = Files.classify_source_file current_file in match Files.read_file current_file with | None -> print_null () | Some source -> ( match - Commands.signature_help ~state ~source ~kind_file ~pos + Signature_help.signature_help ~source ~kind_file ~pos ~allow_for_constructor_payloads ~full ~debug with | None -> print_null () | Some s -> Lsp.Types.SignatureHelp.yojson_of_t s |> print_string) -let code_action ~state ~path ~start_pos ~end_pos ~current_file ~debug = +let code_action ~path ~start_pos ~end_pos ~current_file ~debug = let kind_file = Files.classify_source_file current_file in match Files.read_file current_file with | None -> print_null () | Some source -> - Xform.extract_code_actions ~state ~path ~start_pos ~end_pos ~source - ~kind_file ~debug + Xform.extract_code_actions ~path ~start_pos ~end_pos ~source ~kind_file + ~debug |> List.map (fun c -> Lsp.Types.CodeAction.yojson_of_t c) |> print_list -let definition ~state ~path ~pos ~debug = - let full = Cmt.load_full_cmt_from_path ~state ~path in +let definition ~path ~pos ~debug = + let full = Cmt.load_full_cmt_from_path ~path in - match Commands.definition ~state ~full ~pos ~debug with + match Commands.definition ~full ~pos ~debug with | None -> print_null () | Some location -> location |> Lsp.Types.Location.yojson_of_t |> print_string -let type_definition ~state ~path ~pos ~debug = - let full = Cmt.load_full_cmt_from_path ~state ~path in - match Commands.type_definition ~state ~full ~pos ~debug with +let type_definition ~path ~pos ~debug = + let full = Cmt.load_full_cmt_from_path ~path in + match Commands.type_definition ~full ~pos ~debug with | None -> print_null () | Some location -> location |> Lsp.Types.Location.yojson_of_t |> print_string -let references ~state ~path ~pos ~debug = - let full = Cmt.load_full_cmt_from_path ~state ~path in - let all_locs = Commands.references ~state ~full ~pos ~debug in +let references ~path ~pos ~debug = + let full = Cmt.load_full_cmt_from_path ~path in + let all_locs = Commands.references ~full ~pos ~debug in if all_locs = [] then print_null () else all_locs |> List.map (fun l -> Lsp.Types.Location.yojson_of_t l) |> print_list -let rename ~state ~path ~pos ~new_name ~debug = - let full = Cmt.load_full_cmt_from_path ~state ~path in - match Commands.rename ~state ~full ~pos ~new_name ~debug with +let rename ~path ~pos ~new_name ~debug = + let full = Cmt.load_full_cmt_from_path ~path in + match Commands.rename ~full ~pos ~new_name ~debug with | Some {documentChanges = Some document_changes} -> document_changes |> List.map (fun c -> @@ -116,9 +116,9 @@ let rename ~state ~path ~pos ~new_name ~debug = |> print_list | _ -> print_null () -let prepare_rename ~state ~path ~pos ~debug = - let full = Cmt.load_full_cmt_from_path ~state ~path in - match Commands.prepare_rename ~state ~full ~pos ~debug with +let prepare_rename ~path ~pos ~debug = + let full = Cmt.load_full_cmt_from_path ~path in + match Commands.prepare_rename ~full ~pos ~debug with | None -> print_null () | Some {range; placeholder = None} -> Lsp.Types.Range.yojson_of_t range |> print_string @@ -130,12 +130,12 @@ let prepare_rename ~state ~path ~pos ~debug = ] |> print_string -let format ~state ~path = +let format ~path = match Files.read_file path with | None -> print_null () | Some source -> ( let kind_file = Files.classify_source_file path in - match Commands.format ~state ~source ~kind_file with + match Commands.format ~source ~kind_file with | Ok text_edits -> ( match text_edits with | {newText} :: _ -> print_string (`String newText) @@ -168,7 +168,7 @@ let document_symbol ~path = |> List.map Lsp.Types.DocumentSymbol.yojson_of_t |> print_list -let test ~state ~path = +let test ~path = Uri.strip_path := true; match Files.read_file path with | None -> assert false @@ -233,19 +233,19 @@ let test ~state ~path = print_endline ("Definition " ^ path ^ " " ^ string_of_int line ^ ":" ^ string_of_int col); - definition ~state ~path ~pos:(line, col) ~debug:true + definition ~path ~pos:(line, col) ~debug:true | "com" -> print_endline ("Complete " ^ path ^ " " ^ string_of_int line ^ ":" ^ string_of_int col); let current_file = create_current_file () in - completion ~state ~debug:true ~path ~pos:(line, col) ~current_file; + completion ~debug:true ~path ~pos:(line, col) ~current_file; Sys.remove current_file | "cre" -> let module_path = String.sub rest 3 (String.length rest - 3) in let module_path = String.trim module_path in print_endline ("Completion resolve: " ^ module_path); - completion_resolve ~state ~path ~module_path + completion_resolve ~path ~module_path | "dce" -> print_endline ("DCE " ^ path); Reanalyze.Run_config.run_config.suppress <- ["src"]; @@ -268,7 +268,7 @@ let test ~state ~path = ("Hover " ^ path ^ " " ^ string_of_int line ^ ":" ^ string_of_int col); let current_file = create_current_file () in - hover ~state ~supports_markdown_links:true ~path ~pos:(line, col) + hover ~supports_markdown_links:true ~path ~pos:(line, col) ~current_file ~debug:true; Sys.remove current_file | "she" -> @@ -276,8 +276,8 @@ let test ~state ~path = ("Signature help " ^ path ^ " " ^ string_of_int line ^ ":" ^ string_of_int col); let current_file = create_current_file () in - signature_help ~state ~path ~pos:(line, col) ~current_file - ~debug:true ~allow_for_constructor_payloads:true; + signature_help ~path ~pos:(line, col) ~current_file ~debug:true + ~allow_for_constructor_payloads:true; Sys.remove current_file | "int" -> print_endline ("Create Interface " ^ path); @@ -288,17 +288,17 @@ let test ~state ~path = let dir = dirname path in dir ++ parent_dir_name ++ "lib" ++ "bs" ++ "src" ++ name in - Printf.printf "%s" (Create_interface.command ~state ~path ~cmi_file) + Printf.printf "%s" (Create_interface.command ~path ~cmi_file) | "ref" -> print_endline ("References " ^ path ^ " " ^ string_of_int line ^ ":" ^ string_of_int col); - references ~state ~path ~pos:(line, col) ~debug:true + references ~path ~pos:(line, col) ~debug:true | "pre" -> print_endline ("PrepareRename " ^ path ^ " " ^ string_of_int line ^ ":" ^ string_of_int col); - prepare_rename ~state ~path ~pos:(line, col) ~debug:true + prepare_rename ~path ~pos:(line, col) ~debug:true | "ren" -> let new_name = String.sub rest 4 (len - mlen - 4) in let () = @@ -306,12 +306,12 @@ let test ~state ~path = ("Rename " ^ path ^ " " ^ string_of_int line ^ ":" ^ string_of_int col ^ " " ^ new_name) in - rename ~state ~path ~pos:(line, col) ~new_name ~debug:true + rename ~path ~pos:(line, col) ~new_name ~debug:true | "typ" -> print_endline ("TypeDefinition " ^ path ^ " " ^ string_of_int line ^ ":" ^ string_of_int col); - type_definition ~state ~path ~pos:(line, col) ~debug:true + type_definition ~path ~pos:(line, col) ~debug:true | "xfm" -> let current_file = create_current_file () in (* +2 is to ensure that the character ^ points to is what's considered the end of the selection. *) @@ -332,8 +332,8 @@ let test ~state ~path = in let kind_file = Files.classify_source_file current_file in let code_actions = - Xform.extract_code_actions ~state ~path ~start_pos ~end_pos - ~source ~kind_file ~debug:true + Xform.extract_code_actions ~path ~start_pos ~end_pos ~source + ~kind_file ~debug:true in Sys.remove current_file; code_actions @@ -411,11 +411,11 @@ let test ~state ~path = print_endline ("Inlay Hint " ^ path ^ " " ^ string_of_int line_start ^ ":" ^ string_of_int line_end); - inlayhint ~state ~path ~pos:(line_start, line_end) ~max_length:"25" + inlayhint ~path ~pos:(line_start, line_end) ~max_length:"25" ~debug:false | "cle" -> print_endline ("Code Lens " ^ path); - code_lens ~state ~path ~debug:false + code_lens ~path ~debug:false | "ast" -> print_endline ("Dump AST " ^ path ^ " " ^ string_of_int line ^ ":" diff --git a/analysis/src/cmt.ml b/analysis/src/cmt.ml index b17e04478ae..2556ed56150 100644 --- a/analysis/src/cmt.ml +++ b/analysis/src/cmt.ml @@ -34,9 +34,9 @@ let full_from_module_uri ~package ~module_name ~uri ~paths = let cmt = get_cmt_path ~uri paths in full_for_cmt ~module_name ~package ~uri cmt -let full_from_uri ~state ~uri = +let full_from_uri ~uri = let path = Uri.to_path uri in - match Packages.get_package ~state ~uri with + match Packages.get_package ~uri with | None -> None | Some package -> ( let module_name = @@ -53,13 +53,13 @@ let full_from_uri ~state ~uri = prerr_endline ("can't find module " ^ module_name); None)) -let full_from_module ?state:_ ~package ~module_name = +let full_from_module ~package ~module_name = Option.bind (Hashtbl.find_opt package.paths_for_module module_name) @@ fun paths -> let uri = get_uri paths in full_from_module_uri ~package ~module_name ~uri ~paths -let fulls_from_module ?state:_ ~package ~module_name = +let fulls_from_module ~package ~module_name = match Hashtbl.find_opt package.paths_for_module module_name with | None -> [] | Some paths -> @@ -68,13 +68,13 @@ let fulls_from_module ?state:_ ~package ~module_name = |> List.filter_map (fun uri -> full_from_module_uri ~package ~module_name ~uri ~paths) -let load_full_cmt_from_path ~state ~path = +let load_full_cmt_from_path ~path = let uri = Uri.from_path path in - full_from_uri ~state ~uri + full_from_uri ~uri -let load_cmt_infos_from_path ~state ~path = +let load_cmt_infos_from_path ~path = let uri = Uri.from_path path in - match Packages.get_package ~state ~uri with + match Packages.get_package ~uri with | None -> None | Some package -> ( let module_name = diff --git a/analysis/src/cmt_viewer.ml b/analysis/src/cmt_viewer.ml index ce32f8885bc..39bf9f544f8 100644 --- a/analysis/src/cmt_viewer.ml +++ b/analysis/src/cmt_viewer.ml @@ -16,11 +16,11 @@ let filter_by_cursor cursor (loc : Warnings.loc) : bool = type filter = Cursor of (int * int) | Loc of Loc.t -let dump ~state ?filter rescript_json cmt_path = +let dump ?filter rescript_json cmt_path = let uri = Uri.from_path (Filename.remove_extension cmt_path ^ ".res") in let package = let uri = Uri.from_path rescript_json in - Packages.get_package ~state ~uri |> Option.get + Packages.get_package ~uri |> Option.get in let module_name = Build_system.namespaced_name package.namespace diff --git a/analysis/src/commands.ml b/analysis/src/commands.ml index adbd21be706..be6c0a83c46 100644 --- a/analysis/src/commands.ml +++ b/analysis/src/commands.ml @@ -1,14 +1,13 @@ -let completion ~state ~debug ~source ~kind_file ~pos ~full = +let completion ~debug ~source ~kind_file ~pos ~full = match Completions.get_completions ~debug ~source ~kind_file ~pos ~full ~for_hover:false with | None -> [] | Some (completions, full, _) -> - completions - |> List.map (Completion_back_end.completion_to_item ~state ~full) + completions |> List.map (Completion_back_end.completion_to_item ~full) -let completion_resolve ~state ~(full : Shared_types.full option) ~module_path = +let completion_resolve ~(full : Shared_types.full option) ~module_path = (* We ignore the internal module path as of now because there's currently no use case for it. But, if we wanted to move resolving documentation for regular modules and not just file modules to the completionResolve @@ -26,9 +25,7 @@ let completion_resolve ~state ~(full : Shared_types.full option) ~module_path = Printf.printf "[completion_resolve] Could not load cmt\n"; None | Some full -> ( - match - Process_cmt.file_for_module ~state ~package:full.package module_name - with + match Process_cmt.file_for_module ~package:full.package module_name with | None -> if Debug.verbose () then Printf.printf "[completion_resolve] Did not find file for module %s\n" @@ -44,7 +41,7 @@ let completion_resolve ~state ~(full : Shared_types.full option) ~module_path = (Lsp.Types.MarkupContent.create ~kind:Lsp.Types.MarkupKind.Markdown ~value)) -let hover ~state ~source ~kind_file ~pos ~supports_markdown_links ~full ~debug = +let hover ~source ~kind_file ~pos ~supports_markdown_links ~full ~debug = let result = match full with | None -> None @@ -55,7 +52,7 @@ let hover ~state ~source ~kind_file ~pos ~supports_markdown_links ~full ~debug = Printf.printf "Nothing at that position. Now trying to use completion.\n"; match - Hover.get_hover_via_completions ~debug ~source ~kind_file ~pos ~state + Hover.get_hover_via_completions ~debug ~source ~kind_file ~pos ~for_hover:true ~supports_markdown_links ~full:(Some full) with | None -> None @@ -66,9 +63,7 @@ let hover ~state ~source ~kind_file ~pos ~supports_markdown_links ~full ~debug = | LModule _ | TopLevelModule _ -> true | TypeDefinition _ | Typed _ | Constant _ -> false in - let uri_loc_opt = - References.definition_for_loc_item ~state ~full loc_item - in + let uri_loc_opt = References.definition_for_loc_item ~full loc_item in let skip_zero = match uri_loc_opt with | None -> false @@ -82,7 +77,7 @@ let hover ~state ~source ~kind_file ~pos ~supports_markdown_links ~full ~debug = && pos_is_zero loc.loc_end in if skip_zero then None - else Hover.new_hover ~state ~supports_markdown_links ~full loc_item) + else Hover.new_hover ~supports_markdown_links ~full loc_item) in match result with | None -> None @@ -95,12 +90,12 @@ let hover ~state ~source ~kind_file ~pos ~supports_markdown_links ~full ~debug = ~kind:Lsp.Types.MarkupKind.Markdown ~value)) ()) -let signature_help ~state:_ ~source ~kind_file ~pos - ~allow_for_constructor_payloads ~full ~debug = +let signature_help ~source ~kind_file ~pos ~allow_for_constructor_payloads ~full + ~debug = Signature_help.signature_help ~debug ~source ~kind_file ~pos ~allow_for_constructor_payloads ~full -let definition ~state ~full ~pos ~debug = +let definition ~full ~pos ~debug = let location_opt = match full with | None -> None @@ -108,7 +103,7 @@ let definition ~state ~full ~pos ~debug = match References.get_loc_item ~full ~pos ~debug with | None -> None | Some loc_item -> ( - match References.definition_for_loc_item ~state ~full loc_item with + match References.definition_for_loc_item ~full loc_item with | None -> None | Some (uri, loc) when not loc.loc_ghost -> let is_interface = full.file.uri |> Uri.is_interface in @@ -135,7 +130,7 @@ let definition ~state ~full ~pos ~debug = in location_opt -let type_definition ~state ~full ~pos ~debug = +let type_definition ~full ~pos ~debug = let maybe_location = match full with | None -> None @@ -143,7 +138,7 @@ let type_definition ~state ~full ~pos ~debug = match References.get_loc_item ~full ~pos ~debug with | None -> None | Some loc_item -> ( - match References.type_definition_for_loc_item ~state ~full loc_item with + match References.type_definition_for_loc_item ~full loc_item with | None -> None | Some (uri, loc) -> Some @@ -153,7 +148,7 @@ let type_definition ~state ~full ~pos ~debug = in maybe_location -let references ~state ~full ~pos ~debug = +let references ~full ~pos ~debug = let all_locs = match full with | None -> [] @@ -162,7 +157,7 @@ let references ~state ~full ~pos ~debug = | None -> [] | Some loc_item -> let all_references = - References.all_references_for_loc_item ~state ~full loc_item + References.all_references_for_loc_item ~full loc_item in all_references |> List.fold_left @@ -181,7 +176,7 @@ let references ~state ~full ~pos ~debug = in all_locs -let rename ~state ~full ~pos ~new_name ~debug = +let rename ~full ~pos ~new_name ~debug = let result = match full with | None -> None @@ -190,7 +185,7 @@ let rename ~state ~full ~pos ~new_name ~debug = | None -> None | Some loc_item -> let all_references = - References.all_references_for_loc_item ~state ~full loc_item + References.all_references_for_loc_item ~full loc_item in let references_to_toplevel_modules = all_references @@ -266,7 +261,7 @@ type prepare_rename_result = { placeholder: string option; } -let prepare_rename ~state:_ ~full ~pos ~debug = +let prepare_rename ~full ~pos ~debug = match full with | None -> None | Some full -> ( @@ -283,7 +278,7 @@ let prepare_rename ~state:_ ~full ~pos ~debug = in Some {range; placeholder = placeholder_opt}) -let format ~state:_ ~source ~kind_file = +let format ~source ~kind_file = let create_range text = let lines = text |> String.split_on_char '\n' in let lines_len = List.length lines in diff --git a/analysis/src/completion_back_end.ml b/analysis/src/completion_back_end.ml index 8071bc06007..66524705675 100644 --- a/analysis/src/completion_back_end.ml +++ b/analysis/src/completion_back_end.ml @@ -27,8 +27,7 @@ let show_constructor {Constructor.cname = {txt}; args; res} = | Some typ -> "\n" ^ (typ |> Shared.type_to_string) (* TODO: local opens *) -let resolve_opens ?state ~env opens ~package = - let state = Option.value state ~default:package.state in +let resolve_opens ~env opens ~package = List.fold_left (fun previous path -> (* Finding an open, first trying to find it in previoulsly resolved opens *) @@ -38,13 +37,13 @@ let resolve_opens ?state ~env opens ~package = match path with | [] | [_] -> previous | name :: path -> ( - match Process_cmt.file_for_module ~state ~package name with + match Process_cmt.file_for_module ~package name with | None -> Log.log ("Could not get module " ^ name); previous (* TODO: warn? *) | Some file -> ( match - Resolve_path.resolve_path ~env:(Query_env.from_file file) ~state + Resolve_path.resolve_path ~env:(Query_env.from_file file) ~package ~path with | None -> @@ -52,12 +51,12 @@ let resolve_opens ?state ~env opens ~package = previous | Some (env, _placeholder) -> previous @ [env]))) | env :: rest -> ( - match Resolve_path.resolve_path ~state ~env ~package ~path with + match Resolve_path.resolve_path ~env ~package ~path with | None -> loop rest | Some (env, _placeholder) -> previous @ [env]) in Log.log ("resolving open " ^ path_to_string path); - match Resolve_path.resolve_path ~state ~env ~package ~path with + match Resolve_path.resolve_path ~env ~package ~path with | None -> Log.log "Not local"; loop previous @@ -177,27 +176,23 @@ let find_module_in_scope ~env ~module_name ~scope = scope |> Scope.iter_modules_after_first_open process_module; !result -let rec module_item_to_structure_env ?state ~(env : Query_env.t) ~package +let rec module_item_to_structure_env ~(env : Query_env.t) ~package (item : Module.t) = - let state = Option.value state ~default:package.state in match item with | Module.Structure structure -> Some (env, structure) | Module.Constraint (_, module_type) -> - module_item_to_structure_env ~state ~env ~package module_type + module_item_to_structure_env ~env ~package module_type | Module.Ident p -> ( - match - Resolve_path.resolve_module_from_compiler_path ~state ~env ~package p - with + match Resolve_path.resolve_module_from_compiler_path ~env ~package p with | Some (env2, Some declared2) -> - module_item_to_structure_env ~state ~env:env2 ~package declared2.item + module_item_to_structure_env ~env:env2 ~package declared2.item | _ -> None) (* Given a declared module, return the env entered into its concrete structure and the structure itself. Follows constraints and aliases *) -let enter_structure_from_declared ?state ~(env : Query_env.t) ~package +let enter_structure_from_declared ~(env : Query_env.t) ~package (declared : Module.t Declared.t) = - let state = Option.value state ~default:package.state in - match module_item_to_structure_env ~state ~env ~package declared.item with + match module_item_to_structure_env ~env ~package declared.item with | Some (env, s) -> Some (Query_env.enter_structure env s, s) | None -> None @@ -221,8 +216,8 @@ let completions_from_structure_items ~(env : Query_env.t) (Completion.create ~env ~docstring:it.docstring ~kind:(Completion.Type t) it.name)) -let resolve_path_from_stamps ~state ~(env : Query_env.t) ~package ~scope - ~module_name ~path = +let resolve_path_from_stamps ~(env : Query_env.t) ~package ~scope ~module_name + ~path = (* Log.log("Finding from stamps " ++ name); *) match find_module_in_scope ~env ~module_name ~scope with | None -> None @@ -242,70 +237,63 @@ let resolve_path_from_stamps ~state ~(env : Query_env.t) ~package ~scope match res with | `Local (env, name) -> Some (env, name) | `Global (module_name, full_path) -> ( - match Process_cmt.file_for_module ~state ~package module_name with + match Process_cmt.file_for_module ~package module_name with | None -> None | Some file -> - Resolve_path.resolve_path ~env:(Query_env.from_file file) ~state + Resolve_path.resolve_path ~env:(Query_env.from_file file) ~path:full_path ~package)))) -let resolve_module_with_opens ~state ~opens ~package ~module_name = +let resolve_module_with_opens ~opens ~package ~module_name = let rec loop opens = match opens with | (env : Query_env.t) :: rest -> ( Log.log ("Looking for env in " ^ Uri.to_string env.file.uri); - match - Resolve_path.resolve_path ~state ~env ~package ~path:[module_name; ""] - with + match Resolve_path.resolve_path ~env ~package ~path:[module_name; ""] with | Some (env, _) -> Some env | None -> loop rest) | [] -> None in loop opens -let resolve_file_module ~state ~module_name ~package = +let resolve_file_module ~module_name ~package = Log.log ("Getting module " ^ module_name); - match Process_cmt.file_for_module ~state ~package module_name with + match Process_cmt.file_for_module ~package module_name with | None -> None | Some file -> Log.log "got it"; let env = Query_env.from_file file in Some env -let get_env_with_opens ?state ~scope ~(env : Query_env.t) ~package +let get_env_with_opens ~scope ~(env : Query_env.t) ~package ~(opens : Query_env.t list) ~module_name (path : string list) = - let state = Option.value state ~default:package.state in (* TODO: handle interleaving of opens and local modules correctly *) - match - resolve_path_from_stamps ~state ~env ~scope ~module_name ~path ~package - with + match resolve_path_from_stamps ~env ~scope ~module_name ~path ~package with | Some x -> Some x | None -> ( let env_opt = - match resolve_module_with_opens ~state ~opens ~package ~module_name with + match resolve_module_with_opens ~opens ~package ~module_name with | Some env_opens -> Some env_opens - | None -> resolve_file_module ~state ~module_name ~package + | None -> resolve_file_module ~module_name ~package in match env_opt with | None -> None | Some env -> ( match path with | [""] -> Some (env, "") - | _ -> Resolve_path.resolve_path ~state ~env ~package ~path)) + | _ -> Resolve_path.resolve_path ~env ~package ~path)) -let rec expand_type_expr ?state ~env ~package type_expr = - let state = Option.value state ~default:package.state in +let rec expand_type_expr ~env ~package type_expr = match type_expr |> Shared.dig_constructor with | Some path -> ( - match References.dig_constructor ~state ~env ~package path with + match References.dig_constructor ~env ~package path with | None -> None | Some (env, {item = {decl = {type_manifest = Some t}}}) -> - expand_type_expr ~state ~env ~package t + expand_type_expr ~env ~package t | Some (_, {docstring; item}) -> Some (docstring, item)) | None -> None -let kind_to_documentation ?state ~env ~full ~current_docstring name +let kind_to_documentation ~env ~full ~current_docstring name (kind : Completion.kind) = - let state = Option.value state ~default:full.package.state in let docs_from_kind = match kind with | ObjLabel _ | Label _ | FileModule _ | Snippet _ | FollowContextPath _ -> @@ -314,7 +302,7 @@ let kind_to_documentation ?state ~env ~full ~current_docstring name | Type {decl; name} -> [decl |> Shared.decl_to_string name |> Markdown.code_block] | Value typ -> ( - match expand_type_expr ~state ~env ~package:full.package typ with + match expand_type_expr ~env ~package:full.package typ with | None -> [] | Some (docstrings, {decl; name; kind}) -> docstrings @@ -711,9 +699,8 @@ let get_complementary_completions_for_typed_value ~opens ~all_files ~scope ~env in local_completions_with_opens @ file_modules -let get_completions_for_path ?state ~debug ~opens ~full ~pos ~exact ~scope +let get_completions_for_path ~debug ~opens ~full ~pos ~exact ~scope ~completion_context ~env path = - let state = Option.value state ~default:full.package.state in if debug then Printf.printf "Path %s\n" (path |> String.concat "."); let all_files = all_files_in_package full.package in match path with @@ -755,15 +742,15 @@ let get_completions_for_path ?state ~debug ~opens ~full ~pos ~exact ~scope | Some (declared : Module.t Declared.t) when declared.is_exported = false -> ( match - enter_structure_from_declared ~state ~env:env_file - ~package:full.package declared + enter_structure_from_declared ~env:env_file ~package:full.package + declared with | None -> [] | Some (env_in_module, structure) -> completions_from_structure_items ~env:env_in_module structure) | _ -> ( match - get_env_with_opens ~state ~scope ~env ~package:full.package ~opens + get_env_with_opens ~scope ~env ~package:full.package ~opens ~module_name path with | Some (env, prefix) -> @@ -774,8 +761,8 @@ let get_completions_for_path ?state ~debug ~opens ~full ~pos ~exact ~scope | None -> [])) | _ -> ( match - get_env_with_opens ~state ~scope ~env ~package:full.package ~opens - ~module_name path + get_env_with_opens ~scope ~env ~package:full.package ~opens ~module_name + path with | Some (env, prefix) -> Log.log "Got the env"; @@ -784,10 +771,8 @@ let get_completions_for_path ?state ~debug ~opens ~full ~pos ~exact ~scope | None -> [])) (** Completions intended for piping, from a completion path. *) -let completions_for_pipe_from_completion_path ?state - ~env_completion_is_made_from ~opens ~pos ~scope ~debug ~prefix ~env - ~raw_opens ~full completion_path = - let state = Option.value state ~default:full.package.state in +let completions_for_pipe_from_completion_path ~env_completion_is_made_from + ~opens ~pos ~scope ~debug ~prefix ~env ~raw_opens ~full completion_path = let completion_path_without_current_module = Type_utils.remove_current_module_if_needed ~env_completion_is_made_from completion_path @@ -803,8 +788,8 @@ let completions_for_pipe_from_completion_path ?state in let completions = completion_path @ [prefix] - |> get_completions_for_path ~state ~debug ~completion_context:Value - ~exact:false ~opens ~full ~pos ~env ~scope + |> get_completions_for_path ~debug ~completion_context:Value ~exact:false + ~opens ~full ~pos ~env ~scope in let completions = completions @@ -813,13 +798,12 @@ let completions_for_pipe_from_completion_path ?state in completions -let rec dig_to_record_fields_for_completion ?state ~debug ~package ~opens ~full - ~pos ~env ~scope path = - let state = Option.value state ~default:package.state in +let rec dig_to_record_fields_for_completion ~debug ~package ~opens ~full ~pos + ~env ~scope path = match path - |> get_completions_for_path ~state ~debug ~completion_context:Type - ~exact:true ~opens ~full ~pos ~env ~scope + |> get_completions_for_path ~debug ~completion_context:Type ~exact:true + ~opens ~full ~pos ~env ~scope with | {kind = Type {kind = Abstract (Some (p, _))}} :: _ -> (* This case happens when what we're looking for is a type alias. @@ -827,8 +811,8 @@ let rec dig_to_record_fields_for_completion ?state ~debug ~package ~opens ~full ReactDOM.domProps is an alias for JsxEvent.t. *) let path_rev = p |> Utils.expand_path in path_rev |> List.rev - |> dig_to_record_fields_for_completion ~state ~debug ~package ~opens ~full - ~pos ~env ~scope + |> dig_to_record_fields_for_completion ~debug ~package ~opens ~full ~pos + ~env ~scope | {kind = Type {kind = Record fields}} :: _ -> Some fields | _ -> None @@ -870,7 +854,7 @@ let mk_item ?data ?additional_text_edits name ~kind ~detail ~deprecated ?deprecated ?data ?additionalTextEdits:additional_text_edits ?sortText:None ?insertText:None ?insertTextFormat:None ?filterText:None () -let completion_to_item ?state +let completion_to_item { Completion.name; deprecated; @@ -884,7 +868,6 @@ let completion_to_item ?state env; additional_text_edits; } ~full = - let state = Option.value state ~default:full.package.state in let item = mk_item name ?additional_text_edits ?data:(kind_to_data (full.file.uri |> Uri.to_path) kind) @@ -896,8 +879,8 @@ let completion_to_item ?state | Some detail -> detail) ~docstring: (match - kind_to_documentation ~state ~current_docstring:docstring ~full ~env - name kind + kind_to_documentation ~current_docstring:docstring ~full ~env name + kind with | "" -> [] | docstring -> [docstring]) @@ -936,9 +919,8 @@ let completions_get_completion_type ~full completions = | Some {Completion.kind = ExtractedType (typ, _); env} -> Some (typ, env) | _ -> None -let rec completions_get_completion_type2 ?state ~debug ~full ~opens ~raw_opens - ~pos completions = - let state = Option.value state ~default:full.package.state in +let rec completions_get_completion_type2 ~debug ~full ~opens ~raw_opens ~pos + completions = let first_non_synthetic_completion = List.find_opt (fun c -> not c.Completion.synthetic) completions in @@ -950,10 +932,9 @@ let rec completions_get_completion_type2 ?state ~debug ~full ~opens ~raw_opens Some (TypeExpr typ, env) | Some {Completion.kind = FollowContextPath (ctx_path, scope); env} -> ctx_path - |> get_completions_for_context_path ~state ~debug ~full ~env ~exact:true - ~opens ~raw_opens ~pos ~scope - |> completions_get_completion_type2 ~state ~debug ~full ~opens ~raw_opens - ~pos + |> get_completions_for_context_path ~debug ~full ~env ~exact:true ~opens + ~raw_opens ~pos ~scope + |> completions_get_completion_type2 ~debug ~full ~opens ~raw_opens ~pos | Some {Completion.kind = Type typ; env} -> ( match Type_utils.extract_type_from_resolved_type typ ~env ~full with | None -> None @@ -962,9 +943,8 @@ let rec completions_get_completion_type2 ?state ~debug ~full ~opens ~raw_opens Some (ExtractedType typ, env) | _ -> None -and completions_get_type_env2 ?state ~debug (completions : Completion.t list) - ~full ~opens ~raw_opens ~pos = - let state = Option.value state ~default:full.package.state in +and completions_get_type_env2 ~debug (completions : Completion.t list) ~full + ~opens ~raw_opens ~pos = let first_non_synthetic_completion = List.find_opt (fun c -> not c.Completion.synthetic) completions in @@ -974,14 +954,13 @@ and completions_get_type_env2 ?state ~debug (completions : Completion.t list) | Some {Completion.kind = Field ({typ}, _); env} -> Some (typ, env) | Some {Completion.kind = FollowContextPath (ctx_path, scope); env} -> ctx_path - |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens - ~pos ~env ~exact:true ~scope - |> completions_get_type_env2 ~state ~debug ~full ~opens ~raw_opens ~pos + |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env + ~exact:true ~scope + |> completions_get_type_env2 ~debug ~full ~opens ~raw_opens ~pos | _ -> None -and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos - ~env ~exact ~scope ?(mode = Regular) context_path = - let state = Option.value state ~default:full.package.state in +and get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env + ~exact ~scope ?(mode = Regular) context_path = let env_completion_is_made_from = env in if debug then Printf.printf "ContextPath %s\n" @@ -1013,8 +992,8 @@ and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos | Regular -> ( match cp - |> get_completions_for_context_path ~state ~debug ~full ~opens - ~raw_opens ~pos ~env ~exact:true ~scope + |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos + ~env ~exact:true ~scope |> completions_get_completion_type ~full with | None -> [] @@ -1035,8 +1014,8 @@ and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos if Debug.verbose () then print_endline "[ctx_path]--> CPOption"; match cp - |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens - ~pos ~env ~exact:true ~scope + |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos + ~env ~exact:true ~scope |> completions_get_completion_type ~full with | None -> [] @@ -1050,8 +1029,8 @@ and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos if Debug.verbose () then print_endline "[ctx_path]--> CPAwait"; match cp - |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens - ~pos ~env ~exact:true ~scope + |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos + ~env ~exact:true ~scope |> completions_get_completion_type ~full with | Some (Tpromise (env, typ), _env) -> @@ -1077,7 +1056,7 @@ and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos let use_tvar_lookup = !Cfg.in_incremental_typechecking_mode in let by_path = path - |> get_completions_for_path ~state ~debug ~opens ~full ~pos ~exact + |> get_completions_for_path ~debug ~opens ~full ~pos ~exact ~completion_context ~env ~scope in let has_tvars = @@ -1100,10 +1079,9 @@ and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos if Debug.verbose () then print_endline "[ctx_path]--> CPApply"; match cp - |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens - ~pos ~env ~exact:true ~scope - |> completions_get_completion_type2 ~state ~debug ~full ~opens ~raw_opens - ~pos + |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos + ~env ~exact:true ~scope + |> completions_get_completion_type2 ~debug ~full ~opens ~raw_opens ~pos with | Some ((TypeExpr typ | ExtractedType (Tfunction {typ})), env) -> ( let rec reconstruct_function_type args t_ret = @@ -1152,18 +1130,18 @@ and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos if Debug.verbose () then print_endline "[ctx_path]--> CPField: M.field"; (* M.field *) path @ [field_name] - |> get_completions_for_path ~state ~debug ~opens ~full ~pos ~exact + |> get_completions_for_path ~debug ~opens ~full ~pos ~exact ~completion_context:Field ~env ~scope | CPField {context_path = cp; field_name; pos_of_dot; expr_loc; in_jsx} -> ( if Debug.verbose () then print_endline "[dot_completion]--> Triggered"; let completions_from_ctx_path = cp - |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens - ~pos ~env ~exact:true ~scope + |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos + ~env ~exact:true ~scope in let main_type_completion_env = completions_from_ctx_path - |> completions_get_type_env2 ~state ~debug ~full ~opens ~raw_opens ~pos + |> completions_get_type_env2 ~debug ~full ~opens ~raw_opens ~pos in match main_type_completion_env with | None -> @@ -1194,8 +1172,8 @@ and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos in let pipe_completions = cp_as_pipe_completion - |> get_completions_for_context_path ~state ~debug ~full ~opens - ~raw_opens ~pos ~env:env_completion_is_made_from ~exact ~scope + |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos + ~env:env_completion_is_made_from ~exact ~scope |> List.filter_map (fun c -> Type_utils.transform_completion_to_pipe_completion ~synthetic:true ~env ?pos_of_dot c) @@ -1206,9 +1184,9 @@ and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos if Debug.verbose () then print_endline "[ctx_path]--> CPObj"; match cp - |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens - ~pos ~env ~exact:true ~scope - |> completions_get_type_env2 ~state ~debug ~full ~opens ~raw_opens ~pos + |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos + ~env ~exact:true ~scope + |> completions_get_type_env2 ~debug ~full ~opens ~raw_opens ~pos with | Some (typ, env) -> ( match typ |> Type_utils.extract_object_type ~env ~package with @@ -1227,9 +1205,9 @@ and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos let env_at_cursor = env in match cp - |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens - ~pos ~env ~exact:true ~scope ~mode:Pipe - |> completions_get_type_env2 ~state ~debug ~full ~opens ~raw_opens ~pos + |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos + ~env ~exact:true ~scope ~mode:Pipe + |> completions_get_type_env2 ~debug ~full ~opens ~raw_opens ~pos with | None -> if Debug.verbose () then @@ -1291,7 +1269,7 @@ and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos match completion_path with | None -> [] | Some (is_from_current_module, completion_path) -> - completions_for_pipe_from_completion_path ~state + completions_for_pipe_from_completion_path ~env_completion_is_made_from ~opens ~pos ~scope ~debug ~prefix ~env ~raw_opens ~full completion_path |> Type_utils.filter_pipeable_functions ~env ~full ~synthetic @@ -1325,7 +1303,7 @@ and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos let globally_configured_completions = globally_configured_completions_for_type |> List.map (fun completion_path -> - completions_for_pipe_from_completion_path ~state + completions_for_pipe_from_completion_path ~env_completion_is_made_from ~opens ~pos ~scope ~debug ~prefix ~env ~raw_opens ~full completion_path) |> List.flatten @@ -1338,7 +1316,7 @@ and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos let extra_completions = Type_utils.get_extra_modules_to_complete_from_for_type ~env ~full typ |> List.map (fun completion_path -> - completions_for_pipe_from_completion_path ~state + completions_for_pipe_from_completion_path ~env_completion_is_made_from ~opens ~pos ~scope ~debug ~prefix ~env ~raw_opens ~full completion_path) |> List.flatten @@ -1354,8 +1332,8 @@ and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos in (* Add completions from the current module. *) let current_module_completions = - get_completions_for_path ~state ~debug ~completion_context:Value - ~exact:false ~opens:[] ~full ~pos ~env:env_at_cursor ~scope [prefix] + get_completions_for_path ~debug ~completion_context:Value ~exact:false + ~opens:[] ~full ~pos ~env:env_at_cursor ~scope [prefix] |> Type_utils.filter_pipeable_functions ~synthetic:true ~env ~full ~target_type_id:main_type_id in @@ -1368,8 +1346,8 @@ and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos ctx_paths |> List.map (fun context_path -> context_path - |> get_completions_for_context_path ~state ~debug ~full ~opens - ~raw_opens ~pos ~env ~exact:true ~scope) + |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens + ~pos ~env ~exact:true ~scope) |> List.filter_map (fun completion_items -> match completion_items with | {Completion.kind = Value typ} :: _ -> Some typ @@ -1385,9 +1363,9 @@ and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos if Debug.verbose () then print_endline "[ctx_path]--> CJsxPropValue"; let find_type_of_value path = path - |> get_completions_for_path ~state ~debug ~completion_context:Value - ~exact:true ~opens ~full ~pos ~env ~scope - |> completions_get_type_env2 ~state ~debug ~full ~opens ~raw_opens ~pos + |> get_completions_for_path ~debug ~completion_context:Value ~exact:true + ~opens ~full ~pos ~env ~scope + |> completions_get_type_env2 ~debug ~full ~opens ~raw_opens ~pos in let lowercase_component = match path_to_component with @@ -1400,7 +1378,7 @@ and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos let rec dig_to_type_for_completion path = match path - |> get_completions_for_path ~state ~debug ~completion_context:Type + |> get_completions_for_path ~debug ~completion_context:Type ~exact:true ~opens ~full ~pos ~env ~scope with | {kind = Type {kind = Abstract (Some (p, _))}} :: _ -> @@ -1462,10 +1440,9 @@ and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos let labels, env = match function_context_path - |> get_completions_for_context_path ~state ~debug ~full ~opens - ~raw_opens ~pos ~env ~exact:true ~scope - |> completions_get_completion_type2 ~state ~debug ~full ~opens - ~raw_opens ~pos + |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos + ~env ~exact:true ~scope + |> completions_get_completion_type2 ~debug ~full ~opens ~raw_opens ~pos with | Some ((TypeExpr typ | ExtractedType (Tfunction {typ})), env) -> if Debug.verbose () then print_endline "--> found function type"; @@ -1510,10 +1487,9 @@ and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos (* TODO(env-stuff) Get rid of innerType etc *) match root_ctx_path - |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens - ~pos ~env ~exact:true ~scope - |> completions_get_completion_type2 ~state ~debug ~full ~opens ~raw_opens - ~pos + |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos + ~env ~exact:true ~scope + |> completions_get_completion_type2 ~debug ~full ~opens ~raw_opens ~pos with | Some (typ, env) -> ( match @@ -1529,7 +1505,7 @@ and get_completions_for_context_path ?state ~debug ~full ~opens ~raw_opens ~pos | None -> [] | Some typ_expr -> [Completion.create "dummy" ~env ~kind:(Value typ_expr)]) -let get_opens ~state ~debug ~raw_opens ~package ~env = +let get_opens ~debug ~raw_opens ~package ~env = if debug && raw_opens <> [] then Printf.printf "%s\n" ("Raw opens: " @@ -1543,7 +1519,7 @@ let get_opens ~state ~debug ~raw_opens ~package ~env = ^ String.concat " " (package_opens |> List.map (fun p -> p |> path_to_string))); let resolved_opens = - resolve_opens ~state ~env (List.rev (raw_opens @ package_opens)) ~package + resolve_opens ~env (List.rev (raw_opens @ package_opens)) ~package in if debug && resolved_opens <> [] then Printf.printf "%s\n" @@ -2029,27 +2005,26 @@ let rec complete_typed_value ?(type_arg_context : type_arg_context option) module String_set = Set.Make (String) -let rec process_completable ?state ~debug ~full ~scope ~env ~pos ~for_hover - completable = - let state = Option.value state ~default:full.package.state in +let rec process_completable ~debug ~full ~scope ~env ~pos ~for_hover completable + = if debug then Printf.printf "Completable: %s\n" (Completable.to_string completable); let package = full.package in let raw_opens = Scope.get_raw_opens scope in - let opens = get_opens ~state ~debug ~raw_opens ~package ~env in + let opens = get_opens ~debug ~raw_opens ~package ~env in let all_files = all_files_in_package package in let find_type_of_value path = path - |> get_completions_for_path ~state ~debug ~completion_context:Value - ~exact:true ~opens ~full ~pos ~env ~scope - |> completions_get_type_env2 ~state ~debug ~full ~opens ~raw_opens ~pos + |> get_completions_for_path ~debug ~completion_context:Value ~exact:true + ~opens ~full ~pos ~env ~scope + |> completions_get_type_env2 ~debug ~full ~opens ~raw_opens ~pos in match completable with | Cnone -> [] | Cpath context_path -> context_path - |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens - ~pos ~env ~exact:for_hover ~scope + |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos ~env + ~exact:for_hover ~scope | Cjsx ([id], prefix, idents_seen) when String.uncapitalize_ascii id = id -> ( (* Lowercase JSX tag means builtin *) let mk_label (name, typ_string) = @@ -2067,8 +2042,8 @@ let rec process_completable ?state ~debug ~full ~scope ~env ~pos ~for_hover let from_element_props = match path_to_element_props - |> dig_to_record_fields_for_completion ~state ~debug ~package ~opens - ~full ~pos ~env ~scope + |> dig_to_record_fields_for_completion ~debug ~package ~opens ~full ~pos + ~env ~scope with | None -> None | Some fields -> @@ -2305,9 +2280,9 @@ let rec process_completable ?state ~debug ~full ~scope ~env ~pos ~for_hover let labels = match cp - |> get_completions_for_context_path ~state ~debug ~full ~opens - ~raw_opens ~pos ~env ~exact:true ~scope - |> completions_get_type_env2 ~state ~debug ~full ~opens ~raw_opens ~pos + |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos + ~env ~exact:true ~scope + |> completions_get_type_env2 ~debug ~full ~opens ~raw_opens ~pos with | Some (typ, _env) -> if debug then @@ -2335,16 +2310,15 @@ let rec process_completable ?state ~debug ~full ~scope ~env ~pos ~for_hover let fallback_or_empty ?items () = match (fallback, items) with | Some fallback, (None | Some []) -> - fallback - |> process_completable ~state ~debug ~full ~scope ~env ~pos ~for_hover + fallback |> process_completable ~debug ~full ~scope ~env ~pos ~for_hover | _, Some items -> items | None, None -> [] in match context_path - |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens - ~pos ~env ~exact:true ~scope - |> completions_get_type_env2 ~state ~debug ~full ~opens ~raw_opens ~pos + |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos + ~env ~exact:true ~scope + |> completions_get_type_env2 ~debug ~full ~opens ~raw_opens ~pos with | Some (typ, env) -> ( match @@ -2393,8 +2367,8 @@ let rec process_completable ?state ~debug ~full ~scope ~env ~pos ~for_hover in match context_path - |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens - ~pos ~env ~exact:true ~scope + |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos + ~env ~exact:true ~scope |> completions_get_completion_type ~full with | None -> @@ -2494,8 +2468,8 @@ let rec process_completable ?state ~debug ~full ~scope ~env ~pos ~for_hover in let completions_for_context_path = context_path - |> get_completions_for_context_path ~state ~debug ~full ~opens ~raw_opens - ~pos ~env ~exact:for_hover ~scope + |> get_completions_for_context_path ~debug ~full ~opens ~raw_opens ~pos + ~env ~exact:for_hover ~scope in completions_for_context_path |> List.map (fun (c : Completion.t) -> diff --git a/analysis/src/create_interface.ml b/analysis/src/create_interface.ml index 9805a65e3a5..f74f2e151ea 100644 --- a/analysis/src/create_interface.ml +++ b/analysis/src/create_interface.ml @@ -319,11 +319,11 @@ let print_signature ~extractor ~signature = process_signature ~indent:"" signature; Buffer.contents buf -let command ~state ~path ~cmi_file = +let command ~path ~cmi_file = match Shared.try_read_cmi cmi_file with | Some cmi_info -> (* For reading the config *) - ignore (Cmt.load_full_cmt_from_path ~state ~path); + let _ = Cmt.load_full_cmt_from_path ~path in let extractor = Source_file_extractor.create ~path in print_signature ~extractor ~signature:cmi_info.cmi_sign | None -> "" diff --git a/analysis/src/hover.ml b/analysis/src/hover.ml index ff131dfdc43..f87029695a3 100644 --- a/analysis/src/hover.ml +++ b/analysis/src/hover.ml @@ -34,7 +34,7 @@ let show_module_top_level ~docstring ~is_type ~name in Some (doc ^ full) -let rec show_module ~state ~docstring ~(file : File.t) ~package ~name +let rec show_module ~docstring ~(file : File.t) ~package ~name (declared : Module.t Declared.t option) = match declared with | None -> @@ -48,15 +48,13 @@ let rec show_module ~state ~docstring ~(file : File.t) ~package ~name show_module_top_level ~docstring ~is_type ~name items | Some ({item = Constraint (_moduleItem, module_type_item)} as declared) -> (* show the interface *) - show_module ~state ~docstring ~file ~name ~package + show_module ~docstring ~file ~name ~package (Some {declared with item = module_type_item}) | Some ({item = Ident path} as declared) -> ( - match - References.resolve_module_reference ~state ~file ~package declared - with + match References.resolve_module_reference ~file ~package declared with | None -> Some ("Unable to resolve module reference " ^ Path.name path) - | Some (_, declared) -> - show_module ~state ~docstring ~file ~name ~package declared) + | Some (_, declared) -> show_module ~docstring ~file ~name ~package declared + ) type extracted_type = { name: string; @@ -66,8 +64,7 @@ type extracted_type = { loc: Warnings.loc; } -let find_relevant_types_from_type ?state ~file ~package typ = - let state = Option.value state ~default:package.state in +let find_relevant_types_from_type ~file ~package typ = (* Expand definitions of types mentioned in typ. If typ itself is a record or variant, search its body *) let env = Query_env.from_file file in @@ -77,7 +74,7 @@ let find_relevant_types_from_type ?state ~file ~package typ = let label_declarations_types lds = lds |> List.map (fun (ld : Types.label_declaration) -> ld.ld_type) in - match References.dig_constructor ~state ~env ~package path with + match References.dig_constructor ~env ~package path with | None -> (env, [typ]) | Some (env1, {item = {decl}}) -> ( match decl.type_kind with @@ -102,7 +99,7 @@ let find_relevant_types_from_type ?state ~file ~package typ = | None -> (env, [typ]) in let from_constructor_path ~env path = - match References.dig_constructor ~state ~env ~package path with + match References.dig_constructor ~env ~package path with | None -> None | Some (env, {name = {txt}; extent_loc; item = {decl}}) -> if Utils.is_uncurried_internal path then None @@ -111,9 +108,8 @@ let find_relevant_types_from_type ?state ~file ~package typ = let constructors = Shared.find_type_constructors types_to_search in constructors |> List.filter_map (from_constructor_path ~env:env_to_search) -let expand_types ?state ~file ~package ~supports_markdown_links typ = - let state = Option.value state ~default:package.state in - match find_relevant_types_from_type ~state typ ~file ~package with +let expand_types ~file ~package ~supports_markdown_links typ = + match find_relevant_types_from_type typ ~file ~package with | {decl; path} :: _ when Res_parsetree_viewer.has_inline_record_definition_attribute decl.type_attributes -> @@ -162,11 +158,10 @@ let expand_types ?state ~file ~package ~supports_markdown_links typ = `Default ) (* Produces a hover with relevant types expanded in the main type being hovered. *) -let hover_with_expanded_types ?state ~file ~package ~supports_markdown_links - ?docstring ?constructor typ = - let state = Option.value state ~default:package.state in +let hover_with_expanded_types ~file ~package ~supports_markdown_links ?docstring + ?constructor typ = let expanded_types, expansion_type = - expand_types ~state ~file ~package ~supports_markdown_links typ + expand_types ~file ~package ~supports_markdown_links typ in match expansion_type with | `Default -> @@ -190,7 +185,7 @@ let hover_with_expanded_types ?state ~file ~package ~supports_markdown_links (* Leverages autocomplete functionality to produce a hover for a position. This makes it (most often) work with unsaved content. *) -let get_hover_via_completions ~state ~debug ~source ~kind_file ~pos ~for_hover +let get_hover_via_completions ~debug ~source ~kind_file ~pos ~for_hover ~supports_markdown_links ~full = match Completions.get_completions ~debug ~source ~kind_file ~pos ~for_hover ~full @@ -208,38 +203,36 @@ let get_hover_via_completions ~state ~debug ~source ~kind_file ~pos ~for_hover Some (String.concat "\n\n" parts) | {kind = Field _; env; docstring} :: _ -> ( let opens = - Completion_back_end.get_opens ~state ~debug ~raw_opens ~package ~env + Completion_back_end.get_opens ~debug ~raw_opens ~package ~env in match - Completion_back_end.completions_get_type_env2 ~state ~debug ~full - ~raw_opens ~opens ~pos completions + Completion_back_end.completions_get_type_env2 ~debug ~full ~raw_opens + ~opens ~pos completions with | Some (typ, _env) -> let type_string = - hover_with_expanded_types ~state ~file ~package ~docstring + hover_with_expanded_types ~file ~package ~docstring ~supports_markdown_links typ in Some type_string | None -> None) | {env} :: _ -> ( let opens = - Completion_back_end.get_opens ~state ~debug ~raw_opens ~package ~env + Completion_back_end.get_opens ~debug ~raw_opens ~package ~env in match - Completion_back_end.completions_get_type_env2 ~state ~debug ~full - ~raw_opens ~opens ~pos completions + Completion_back_end.completions_get_type_env2 ~debug ~full ~raw_opens + ~opens ~pos completions with | Some (typ, _env) -> let type_string = - hover_with_expanded_types ~state ~file ~package - ~supports_markdown_links typ + hover_with_expanded_types ~file ~package ~supports_markdown_links typ in Some type_string | None -> None) | _ -> None) -let new_hover ?state ~full:{file; package} ~supports_markdown_links loc_item = - let state = Option.value state ~default:package.state in +let new_hover ~full:{file; package} ~supports_markdown_links loc_item = match loc_item.loc_type with | TypeDefinition (name, decl, _stamp) -> ( let type_def = Markdown.code_block (Shared.decl_to_string name decl) in @@ -247,7 +240,7 @@ let new_hover ?state ~full:{file; package} ~supports_markdown_links loc_item = | None -> Some type_def | Some typ -> ( let expanded_types, expansion_type = - expand_types ~state ~file ~package ~supports_markdown_links typ + expand_types ~file ~package ~supports_markdown_links typ in match expansion_type with | `Default -> Some (type_def :: expanded_types |> String.concat "\n") @@ -257,7 +250,7 @@ let new_hover ?state ~full:{file; package} ~supports_markdown_links loc_item = match Stamps.find_module file.stamps stamp with | None -> None | Some md -> ( - match References.resolve_module_reference ~state ~file ~package md with + match References.resolve_module_reference ~file ~package md with | None -> None | Some (file, declared) -> let name, docstring = @@ -265,21 +258,19 @@ let new_hover ?state ~full:{file; package} ~supports_markdown_links loc_item = | Some d -> (d.name.txt, d.docstring) | None -> (file.module_name, file.structure.docstring) in - show_module ~state ~docstring ~name ~file declared ~package)) + show_module ~docstring ~name ~file declared ~package)) | LModule (GlobalReference (module_name, path, tip)) -> ( - match Process_cmt.file_for_module ~state ~package module_name with + match Process_cmt.file_for_module ~package module_name with | None -> None | Some file -> ( let env = Query_env.from_file file in - match References.exported_for_tip ~state ~env ~path ~package ~tip with + match References.exported_for_tip ~env ~path ~package ~tip with | None -> None | Some (_env, _name, stamp) -> ( match Stamps.find_module file.stamps stamp with | None -> None | Some md -> ( - match - References.resolve_module_reference ~state ~file ~package md - with + match References.resolve_module_reference ~file ~package md with | None -> None | Some (file, declared) -> let name, docstring = @@ -287,14 +278,14 @@ let new_hover ?state ~full:{file; package} ~supports_markdown_links loc_item = | Some d -> (d.name.txt, d.docstring) | None -> (file.module_name, file.structure.docstring) in - show_module ~state ~docstring ~name ~file ~package declared)))) + show_module ~docstring ~name ~file ~package declared)))) | LModule NotFound -> None | TopLevelModule name -> ( - match Process_cmt.file_for_module ~state ~package name with + match Process_cmt.file_for_module ~package name with | None -> None | Some file -> - show_module ~state ~docstring:file.structure.docstring - ~name:file.module_name ~file ~package None) + show_module ~docstring:file.structure.docstring ~name:file.module_name + ~file ~package None) | Typed (_, _, Definition (_, (Field _ | Constructor _))) -> None | Constant t -> Some @@ -309,7 +300,7 @@ let new_hover ?state ~full:{file; package} ~supports_markdown_links loc_item = | Const_bigint _ -> "bigint")) | Typed (_, t, loc_kind) -> ( let from_type ?docstring ?constructor typ = - hover_with_expanded_types ~state ~file ~package ~supports_markdown_links + hover_with_expanded_types ~file ~package ~supports_markdown_links ?docstring ?constructor typ in (* Expand first-class modules to the underlying module type signature. *) @@ -318,17 +309,17 @@ let new_hover ?state ~full:{file; package} ~supports_markdown_links loc_item = | Tpackage (path, _lids, _tys) -> ( let env = Query_env.from_file file in match - Resolve_path.resolve_module_from_compiler_path ~state ~env ~package path + Resolve_path.resolve_module_from_compiler_path ~env ~package path with | None -> Some (from_type t) | Some (env_for_module, Some declared) -> let name = Path.name path in - show_module ~state ~docstring:declared.docstring ~name + show_module ~docstring:declared.docstring ~name ~file:env_for_module.file ~package (Some declared) | Some (_, None) -> Some (from_type t)) | _ -> Some - (match References.defined_for_loc ~state ~file ~package loc_kind with + (match References.defined_for_loc ~file ~package loc_kind with | None -> t |> from_type | Some (docstring, res) -> ( match res with diff --git a/analysis/src/packages.ml b/analysis/src/packages.ml index e0644c6a53f..3a5068f1776 100644 --- a/analysis/src/packages.ml +++ b/analysis/src/packages.ml @@ -33,7 +33,7 @@ let get_re_script_version () = version with Not_found -> default_version) -let new_bs_package ~state ~root_path = +let new_bs_package ~root_path = let rescript_json = Filename.concat root_path "rescript.json" in let parse_raw raw = @@ -173,7 +173,6 @@ let new_bs_package ~state ~root_path = |> List.map (fun path -> path @ ["place holder"]) in { - state; generic_jsx_module; suffix; rescript_version; @@ -207,7 +206,7 @@ let find_root ~uri packages_by_root = in loop (if Sys.is_directory path then path else Filename.dirname path) -let get_package ~state ~uri = +let get_package ~uri = let open Shared_types in if Hashtbl.mem state.root_for_uri uri then Some @@ -224,7 +223,7 @@ let get_package ~state ~uri = (Hashtbl.find state.packages_by_root (Hashtbl.find state.root_for_uri uri)) | Some (`Bs root_path) -> ( - match new_bs_package ~state ~root_path with + match new_bs_package ~root_path with | None -> None | Some package -> Hashtbl.replace state.root_for_uri uri package.root_path; diff --git a/analysis/src/process_cmt.ml b/analysis/src/process_cmt.ml index 5624077dfa3..24066d80cec 100644 --- a/analysis/src/process_cmt.ml +++ b/analysis/src/process_cmt.ml @@ -782,7 +782,7 @@ let file_for_cmt_infos ~module_name ~uri {uri; module_name = cmt_modname; stamps = env.stamps; structure} | _ -> File.create module_name uri -let file_for_cmt ~state ~module_name ~cmt ~uri = +let file_for_cmt ~module_name ~cmt ~uri = match Hashtbl.find_opt state.cmt_cache cmt with | Some file -> Some file | None -> ( @@ -793,14 +793,13 @@ let file_for_cmt ~state ~module_name ~cmt ~uri = Hashtbl.replace state.cmt_cache cmt file; Some file) -let file_for_module ?state module_name ~package = - let state = Option.value state ~default:package.state in +let file_for_module module_name ~package = match Hashtbl.find_opt package.paths_for_module module_name with | Some paths -> let uri = get_uri paths in let cmt = get_cmt_path ~uri paths in Log.log ("fileForModule " ^ show_paths paths); - file_for_cmt ~state ~cmt ~module_name ~uri + file_for_cmt ~cmt ~module_name ~uri | None -> Log.log ("No path for module " ^ module_name); None diff --git a/analysis/src/references.ml b/analysis/src/references.ml index 5115cdf7815..74d6f7f91aa 100644 --- a/analysis/src/references.ml +++ b/analysis/src/references.ml @@ -161,8 +161,8 @@ let get_constructor (file : File.t) stamp name = | Some const -> Some const) | _ -> None) -let exported_for_tip ~state ~env ~path ~package ~(tip : Tip.t) = - match Resolve_path.resolve_path ~state ~env ~path ~package with +let exported_for_tip ~env ~path ~package ~(tip : Tip.t) = + match Resolve_path.resolve_path ~env ~path ~package with | None -> Log.log ("Cannot resolve path " ^ path_to_string path); None @@ -179,8 +179,7 @@ let exported_for_tip ~state ~env ~path ~package ~(tip : Tip.t) = None | Some stamp -> Some (env, name, stamp)) -let defined_for_loc ?state ~file ~package loc_kind = - let state = Option.value state ~default:package.state in +let defined_for_loc ~file ~package loc_kind = let inner ~file stamp (tip : Tip.t) = match tip with | Constructor name -> ( @@ -208,13 +207,13 @@ let defined_for_loc ?state ~file ~package loc_kind = inner ~file stamp tip | GlobalReference (module_name, path, tip) -> ( maybe_log ("Getting global " ^ module_name); - match Process_cmt.file_for_module ~state ~package module_name with + match Process_cmt.file_for_module ~package module_name with | None -> Log.log ("Cannot get module " ^ module_name); None | Some file -> ( let env = Query_env.from_file file in - match exported_for_tip ~state ~env ~path ~package ~tip with + match exported_for_tip ~env ~path ~package ~tip with | None -> None | Some (env, name, stamp) -> ( maybe_log ("Getting for " ^ string_of_int stamp ^ " in " ^ name); @@ -227,9 +226,7 @@ let defined_for_loc ?state ~file ~package loc_kind = Some res))) (** Find alternative declaration: from res in case of interface, or from resi in case of implementation *) -let alternate_declared ?state ~(file : File.t) ~package - (declared : _ Declared.t) tip = - let state = Option.value state ~default:package.state in +let alternate_declared ~(file : File.t) ~package (declared : _ Declared.t) tip = match Hashtbl.find_opt package.paths_for_module file.module_name with | None -> None | Some paths -> ( @@ -238,14 +235,14 @@ let alternate_declared ?state ~(file : File.t) ~package maybe_log ("alternateDeclared for " ^ file.module_name ^ " has both resi and res"); let alternate_uri = if Uri.is_interface file.uri then res else resi in - match Cmt.full_from_uri ~state ~uri:(Uri.from_path alternate_uri) with + match Cmt.full_from_uri ~uri:(Uri.from_path alternate_uri) with | None -> None | Some {file; extra} -> ( let env = Query_env.from_file file in let path = Module_path.to_path declared.module_path declared.name.txt in maybe_log ("find declared for path " ^ path_to_string path); let declared_opt = - match exported_for_tip ~state ~env ~path ~package ~tip with + match exported_for_tip ~env ~path ~package ~tip with | None -> None | Some (_env, _name, stamp) -> declared_for_tip ~stamps:file.stamps stamp tip @@ -258,13 +255,12 @@ let alternate_declared ?state ~(file : File.t) ~package None) -let rec resolve_module_reference ?(paths_seen = []) ?state ~file ~package +let rec resolve_module_reference ?(paths_seen = []) ~file ~package (declared : Module.t Declared.t) = - let state = Option.value state ~default:package.state in match declared.item with | Structure _ -> Some (file, Some declared) | Constraint (_moduleItem, module_type_item) -> - resolve_module_reference ~paths_seen ~state ~file ~package + resolve_module_reference ~paths_seen ~file ~package {declared with item = module_type_item} | Ident path -> ( let env = Query_env.from_file file in @@ -278,11 +274,11 @@ let rec resolve_module_reference ?(paths_seen = []) ?state ~file ~package | None -> None | Some md -> Some (env.file, Some md))) | Global (module_name, path) -> ( - match Process_cmt.file_for_module ~state ~package module_name with + match Process_cmt.file_for_module ~package module_name with | None -> None | Some file -> ( let env = Query_env.from_file file in - match Resolve_path.resolve_path ~state ~env ~package ~path with + match Resolve_path.resolve_path ~env ~package ~path with | None -> None | Some (env, name) -> ( match Exported.find env.exported Exported.Module name with @@ -296,11 +292,11 @@ let rec resolve_module_reference ?(paths_seen = []) ?state ~file ~package | None -> None | Some ({item = Ident path} as md) when not (List.mem path paths_seen) -> (* avoid possible infinite loops *) - resolve_module_reference ~state ~file ~package - ~paths_seen:(path :: paths_seen) md + resolve_module_reference ~file ~package ~paths_seen:(path :: paths_seen) + md | Some md -> Some (file, Some md)) | GlobalMod name -> ( - match Process_cmt.file_for_module ~state ~package name with + match Process_cmt.file_for_module ~package name with | None -> None | Some file -> Some (file, None))) @@ -315,12 +311,11 @@ let validate_loc (loc : Location.t) (backup : Location.t) = else backup else loc -let resolve_module_definition ?state ~(file : File.t) ~package stamp = - let state = Option.value state ~default:package.state in +let resolve_module_definition ~(file : File.t) ~package stamp = match Stamps.find_module file.stamps stamp with | None -> None | Some md -> ( - match resolve_module_reference ~state ~file ~package md with + match resolve_module_reference ~file ~package md with | None -> None | Some (file, declared) -> let loc = @@ -330,8 +325,7 @@ let resolve_module_definition ?state ~(file : File.t) ~package stamp = in Some (file.uri, loc)) -let definition ?state ~file ~package stamp (tip : Tip.t) = - let state = Option.value state ~default:package.state in +let definition ~file ~package stamp (tip : Tip.t) = match tip with | Constructor name -> ( match get_constructor file stamp name with @@ -341,13 +335,13 @@ let definition ?state ~file ~package stamp (tip : Tip.t) = match get_field file stamp name with | None -> None | Some field -> Some (file.uri, field.fname.loc)) - | Module -> resolve_module_definition ~state ~file ~package stamp + | Module -> resolve_module_definition ~file ~package stamp | _ -> ( match declared_for_tip ~stamps:file.stamps stamp tip with | None -> None | Some declared -> let file_impl, declared_impl = - match alternate_declared ~state ~package ~file declared tip with + match alternate_declared ~package ~file declared tip with | Some (file_impl, _extra, declared_impl) when Uri.is_interface file.uri -> (file_impl, declared_impl) @@ -356,14 +350,12 @@ let definition ?state ~file ~package stamp (tip : Tip.t) = let loc = validate_loc declared_impl.name.loc declared_impl.extent_loc in let env = Query_env.from_file file_impl in let uri = - Resolve_path.get_source_uri ~state ~env ~package - declared_impl.module_path + Resolve_path.get_source_uri ~env ~package declared_impl.module_path in maybe_log ("Inner uri " ^ Uri.to_string uri); Some (uri, loc)) -let definition_for_loc_item ?state ~full:{file; package} loc_item = - let state = Option.value state ~default:package.state in +let definition_for_loc_item ~full:{file; package} loc_item = match loc_item.loc_type with | Typed (_, _, Definition (stamp, tip)) -> ( maybe_log @@ -375,7 +367,7 @@ let definition_for_loc_item ?state ~full:{file; package} loc_item = maybe_log ("Declared " ^ declared.name.txt); if declared.is_exported then ( maybe_log ("exported, looking for alternate " ^ file.module_name); - match alternate_declared ~state ~package ~file declared tip with + match alternate_declared ~package ~file declared tip with | None -> None | Some (file, _extra, declared) -> let loc = validate_loc declared.name.loc declared.extent_loc in @@ -396,26 +388,25 @@ let definition_for_loc_item ?state ~full:{file; package} loc_item = | LModule (LocalReference (stamp, tip)) | Typed (_, _, LocalReference (stamp, tip)) -> maybe_log ("Local defn " ^ Tip.to_string tip); - definition ~state ~file ~package stamp tip + definition ~file ~package stamp tip | LModule (GlobalReference (module_name, path, tip)) | Typed (_, _, GlobalReference (module_name, path, tip)) -> ( maybe_log ("Typed GlobalReference moduleName:" ^ module_name ^ " path:" ^ path_to_string path ^ " tip:" ^ Tip.to_string tip); - match Process_cmt.file_for_module ~state ~package module_name with + match Process_cmt.file_for_module ~package module_name with | None -> None | Some file -> ( let env = Query_env.from_file file in - match exported_for_tip ~state ~env ~path ~package ~tip with + match exported_for_tip ~env ~path ~package ~tip with | None -> None | Some (env, _name, stamp) -> (* oooh wht do I do if the stamp is inside a pseudo-file? *) maybe_log ("Got stamp " ^ string_of_int stamp); - definition ~state ~file:env.file ~package stamp tip)) + definition ~file:env.file ~package stamp tip)) -let dig_constructor ?state ~env ~package path = - let state = Option.value state ~default:package.state in - match Resolve_path.resolve_from_compiler_path ~state ~env ~package path with +let dig_constructor ~env ~package path = + match Resolve_path.resolve_from_compiler_path ~env ~package path with | NotFound -> None | Stamp stamp -> ( match Stamps.find_type env.file.stamps stamp with @@ -430,8 +421,7 @@ let dig_constructor ?state ~env ~package path = | Some t -> Some (env, t))) | _ -> None -let type_definition_for_loc_item ?state ~full:{file; package} loc_item = - let state = Option.value state ~default:package.state in +let type_definition_for_loc_item ~full:{file; package} loc_item = match loc_item.loc_type with | Constant _ | TopLevelModule _ | LModule _ -> None | TypeDefinition _ -> Some (file.uri, loc_item.loc) @@ -440,7 +430,7 @@ let type_definition_for_loc_item ?state ~full:{file; package} loc_item = match Shared.dig_constructor typ with | None -> None | Some path -> ( - match dig_constructor ~state ~env ~package path with + match dig_constructor ~env ~package path with | Some (env, declared) -> Some (env.file.uri, declared.item.decl.type_loc) | None -> None)) @@ -461,8 +451,7 @@ type references = { loc_opt: Location.t option; (* None: reference to a toplevel module *) } -let for_local_stamp ?state ~full:{file; extra; package} stamp (tip : Tip.t) = - let state = Option.value state ~default:package.state in +let for_local_stamp ~full:{file; extra; package} stamp (tip : Tip.t) = let env = Query_env.from_file file in match match tip with @@ -484,7 +473,7 @@ let for_local_stamp ?state ~full:{file; extra; package} stamp (tip : Tip.t) = | Some declared -> if is_visible declared then ( let alternative_references = - match alternate_declared ~state ~package ~file declared tip with + match alternate_declared ~package ~file declared tip with | None -> [] | Some (file, extra, {stamp}) -> ( match @@ -522,7 +511,7 @@ let for_local_stamp ?state ~full:{file; extra; package} stamp (tip : Tip.t) = package.project_files |> File_set.elements |> List.filter (fun name -> name <> file.module_name) |> List.map (fun module_name -> - Cmt.fulls_from_module ~state ~package ~module_name + Cmt.fulls_from_module ~package ~module_name |> List.map (fun {file; extra} -> match Hashtbl.find_opt extra.external_references @@ -551,15 +540,13 @@ let for_local_stamp ?state ~full:{file; extra; package} stamp (tip : Tip.t) = (locs |> List.map (fun loc -> {uri = file.uri; loc_opt = Some loc})) externals) -let all_references_for_loc_item ?state ~full:({file; package} as full) loc_item - = - let state = Option.value state ~default:package.state in +let all_references_for_loc_item ~full:({file; package} as full) loc_item = match loc_item.loc_type with | TopLevelModule module_name -> let other_modules_references = package.project_files |> File_set.elements |> Utils.filter_map (fun module_name -> - Cmt.full_from_module ~state ~package ~module_name) + Cmt.full_from_module ~package ~module_name) |> List.map (fun full -> match Hashtbl.find_opt full.extra.file_references module_name with | None -> [] @@ -581,24 +568,24 @@ let all_references_for_loc_item ?state ~full:({file; package} as full) loc_item in List.append target_module_references other_modules_references | Typed (_, _, NotFound) | LModule NotFound | Constant _ -> [] - | TypeDefinition (_, _, stamp) -> for_local_stamp ~state ~full stamp Type + | TypeDefinition (_, _, stamp) -> for_local_stamp ~full stamp Type | Typed (_, _, (LocalReference (stamp, tip) | Definition (stamp, tip))) | LModule (LocalReference (stamp, tip) | Definition (stamp, tip)) -> maybe_log ("Finding references for " ^ Uri.to_string file.uri ^ " and stamp " ^ string_of_int stamp ^ " and tip " ^ Tip.to_string tip); - for_local_stamp ~state ~full stamp tip + for_local_stamp ~full stamp tip | LModule (GlobalReference (module_name, path, tip)) | Typed (_, _, GlobalReference (module_name, path, tip)) -> ( - match Process_cmt.file_for_module ~state ~package module_name with + match Process_cmt.file_for_module ~package module_name with | None -> [] | Some file -> ( let env = Query_env.from_file file in - match exported_for_tip ~state ~env ~path ~package ~tip with + match exported_for_tip ~env ~path ~package ~tip with | None -> [] | Some (env, _name, stamp) -> ( match - Cmt.full_from_module ~state ~package ~module_name:env.file.module_name + Cmt.full_from_module ~package ~module_name:env.file.module_name with | None -> [] | Some full -> @@ -606,4 +593,4 @@ let all_references_for_loc_item ?state ~full:({file; package} as full) loc_item ("Finding references for (global) " ^ Uri.to_string env.file.uri ^ " and stamp " ^ string_of_int stamp ^ " and tip " ^ Tip.to_string tip); - for_local_stamp ~state ~full stamp tip))) + for_local_stamp ~full stamp tip))) diff --git a/analysis/src/resolve_path.ml b/analysis/src/resolve_path.ml index 7d176bf8696..9393269359a 100644 --- a/analysis/src/resolve_path.ml +++ b/analysis/src/resolve_path.ml @@ -58,7 +58,7 @@ and find_in_module ~(env : Query_env.t) module_ path = | None -> None | Some {item} -> find_in_module ~env item full_path) -let rec resolve_path ~state ~env ~path ~package = +let rec resolve_path ~env ~path ~package = Log.log ("resolvePath path:" ^ path_to_string path); match resolve_path_inner ~env ~path with | None -> None @@ -69,11 +69,10 @@ let rec resolve_path ~state ~env ~path ~package = Log.log ("resolvePath Global path:" ^ path_to_string full_path ^ " module:" ^ module_name); - match Process_cmt.file_for_module ~state ~package module_name with + match Process_cmt.file_for_module ~package module_name with | None -> None | Some file -> - resolve_path ~state ~env:(Query_env.from_file file) ~path:full_path - ~package)) + resolve_path ~env:(Query_env.from_file file) ~path:full_path ~package)) let from_compiler_path ~(env : Query_env.t) path : resolution = match make_path ~env path with @@ -83,14 +82,14 @@ let from_compiler_path ~(env : Query_env.t) path : resolution = | Exported (env, name) -> Exported (env, name) | Global (module_name, full_path) -> Global (module_name, full_path) -let resolve_module_from_compiler_path ~state ~env ~package path = +let resolve_module_from_compiler_path ~env ~package path = match from_compiler_path ~env path with | Global (module_name, path) -> ( - match Process_cmt.file_for_module ~state ~package module_name with + match Process_cmt.file_for_module ~package module_name with | None -> None | Some file -> ( let env = Query_env.from_file file in - match resolve_path ~state ~env ~package ~path with + match resolve_path ~env ~package ~path with | None -> None | Some (env, name) -> ( match Exported.find env.exported Exported.Module name with @@ -104,7 +103,7 @@ let resolve_module_from_compiler_path ~state ~env ~package path = | None -> None | Some declared -> Some (env, Some declared)) | GlobalMod module_name -> ( - match Process_cmt.file_for_module ~state ~package module_name with + match Process_cmt.file_for_module ~package module_name with | None -> None | Some file -> let env = Query_env.from_file file in @@ -118,15 +117,15 @@ let resolve_module_from_compiler_path ~state ~env ~package path = | None -> None | Some declared -> Some (env, Some declared))) -let resolve_from_compiler_path ~state ~env ~package path = +let resolve_from_compiler_path ~env ~package path = match from_compiler_path ~env path with | Global (module_name, path) -> ( let res = - match Process_cmt.file_for_module ~state ~package module_name with + match Process_cmt.file_for_module ~package module_name with | None -> None | Some file -> let env = Query_env.from_file file in - resolve_path ~state ~env ~package ~path + resolve_path ~env ~package ~path in match res with | None -> NotFound @@ -136,17 +135,15 @@ let resolve_from_compiler_path ~state ~env ~package path = | NotFound -> NotFound | Exported (env, name) -> Exported (env, name) -let rec get_source_uri ~state ~(env : Query_env.t) ~package - (path : Module_path.t) = +let rec get_source_uri ~(env : Query_env.t) ~package (path : Module_path.t) = match path with | File (uri, _moduleName) -> uri | NotVisible -> env.file.uri | IncludedModule (path, inner) -> ( Log.log "INCLUDED MODULE"; - match resolve_module_from_compiler_path ~state ~env ~package path with + match resolve_module_from_compiler_path ~env ~package path with | None -> Log.log "NOT FOUND"; - get_source_uri ~state ~env ~package inner + get_source_uri ~env ~package inner | Some (env, _declared) -> env.file.uri) - | ExportedModule {module_path = inner} -> - get_source_uri ~state ~env ~package inner + | ExportedModule {module_path = inner} -> get_source_uri ~env ~package inner diff --git a/analysis/src/shared_types.ml b/analysis/src/shared_types.ml index 285ae93523b..7685e8cd5b8 100644 --- a/analysis/src/shared_types.ml +++ b/analysis/src/shared_types.ml @@ -519,14 +519,7 @@ type file = string module File_set = Set.Make (String) -type state = { - packages_by_root: (string, package) Hashtbl.t; - root_for_uri: (Uri.t, string) Hashtbl.t; - cmt_cache: (file_path, File.t) Hashtbl.t; -} - -and package = { - state: state; +type package = { generic_jsx_module: string option; suffix: string; root_path: file_path; @@ -552,7 +545,14 @@ let init_extra () = loc_items = []; } -let create_state () = +type state = { + packages_by_root: (string, package) Hashtbl.t; + root_for_uri: (Uri.t, string) Hashtbl.t; + cmt_cache: (file_path, File.t) Hashtbl.t; +} + +(* There's only one state, so it can as well be global *) +let state = { packages_by_root = Hashtbl.create 1; root_for_uri = Hashtbl.create 30; diff --git a/analysis/src/xform.ml b/analysis/src/xform.ml index 4667d464cba..8b78dee94b9 100644 --- a/analysis/src/xform.ml +++ b/analysis/src/xform.ml @@ -2,7 +2,7 @@ let is_braced_expr = Res_parsetree_viewer.is_braced_expr -let extract_type_from_expr ~state expr ~debug ~source ~kind_file ~full ~pos = +let extract_type_from_expr expr ~debug ~source ~kind_file ~full ~pos = match expr.Parsetree.pexp_loc |> Completion_front_end.find_type_of_expression_at_loc ~debug ~source @@ -13,18 +13,18 @@ let extract_type_from_expr ~state expr ~debug ~source ~kind_file ~full ~pos = let env = Shared_types.Query_env.from_file full.Shared_types.file in let completions = completable - |> Completion_back_end.process_completable ~state ~debug ~full ~pos ~scope - ~env ~for_hover:true + |> Completion_back_end.process_completable ~debug ~full ~pos ~scope ~env + ~for_hover:true in let raw_opens = Scope.get_raw_opens scope in match completions with | {env} :: _ -> ( let opens = - Completion_back_end.get_opens ~state ~debug ~raw_opens - ~package:full.package ~env + Completion_back_end.get_opens ~debug ~raw_opens ~package:full.package + ~env in match - Completion_back_end.completions_get_completion_type2 ~state ~debug ~full + Completion_back_end.completions_get_completion_type2 ~debug ~full ~raw_opens ~opens ~pos completions with | Some (typ, _env) -> @@ -385,8 +385,8 @@ module Expand_catch_all_for_variants = struct in {Ast_iterator.default_iterator with expr} - let xform ~state ~source ~kind_file ~path ~pos ~full ~structure ~code_actions - ~debug = + let xform ~source ~kind_file ~path ~pos ~full ~structure ~code_actions ~debug + = let result = ref None in let iterator = mk_iterator ~pos ~result in iterator.structure iterator structure; @@ -421,7 +421,7 @@ module Expand_catch_all_for_variants = struct let current_constructor_names = get_current_constructor_names cases in match switch_expr - |> extract_type_from_expr ~state ~debug ~source ~kind_file ~full + |> extract_type_from_expr ~debug ~source ~kind_file ~full ~pos:(Pos.of_lexing switch_expr.pexp_loc.loc_end) with | Some (Tvariant {constructors}) -> @@ -592,7 +592,7 @@ module Exhaustive_switch = struct in {Ast_iterator.default_iterator with expr} - let xform ~state ~print_expr ~path ~source ~kind_file ~pos ~full ~structure + let xform ~print_expr ~path ~source ~kind_file ~pos ~full ~structure ~code_actions ~debug = (* TODO: Adapt to '(' as leading/trailing character (skip one col, it's not included in the AST) *) let result = ref None in @@ -617,7 +617,7 @@ module Exhaustive_switch = struct | Some (Selection {expr}) -> ( match expr - |> extract_type_from_expr ~state ~debug ~source ~kind_file ~full + |> extract_type_from_expr ~debug ~source ~kind_file ~full ~pos:(Pos.of_lexing expr.pexp_loc.loc_start) with | None -> () @@ -643,7 +643,7 @@ module Exhaustive_switch = struct | Some (Switch {switch_expr; completion_expr; pos}) -> ( match completion_expr - |> extract_type_from_expr ~state ~debug ~source ~kind_file ~full ~pos + |> extract_type_from_expr ~debug ~source ~kind_file ~full ~pos with | None -> () | Some extracted_type -> ( @@ -912,8 +912,7 @@ let parse_interface ~source = in (structure, print_signature_item) -let extract_code_actions ~state ~path ~start_pos ~end_pos ~source ~kind_file - ~debug = +let extract_code_actions ~path ~start_pos ~end_pos ~source ~kind_file ~debug = let pos = start_pos in let code_actions = ref [] in match kind_file with @@ -932,13 +931,13 @@ let extract_code_actions ~state ~path ~start_pos ~end_pos ~source ~kind_file (* This Code Action needs type info *) let () = - match Cmt.load_full_cmt_from_path ~state ~path with + match Cmt.load_full_cmt_from_path ~path with | Some full -> Add_type_annotation.xform ~path ~pos ~full ~structure ~code_actions ~debug; - Expand_catch_all_for_variants.xform ~state ~path ~source ~kind_file ~pos - ~full ~structure ~code_actions ~debug; - Exhaustive_switch.xform ~state ~print_expr ~path ~source ~kind_file + Expand_catch_all_for_variants.xform ~path ~source ~kind_file ~pos ~full + ~structure ~code_actions ~debug; + Exhaustive_switch.xform ~print_expr ~path ~source ~kind_file ~pos: (if start_pos = end_pos then Single start_pos else Range (start_pos, end_pos)) diff --git a/tools/bin/main.ml b/tools/bin/main.ml index b939414e6c4..bf4df8cecd4 100644 --- a/tools/bin/main.ml +++ b/tools/bin/main.ml @@ -82,8 +82,7 @@ let main () = let root_path = if Filename.is_relative root then Unix.realpath root else root in - let state = Analysis.Shared_types.create_state () in - match Analysis.Packages.new_bs_package ~state ~root_path with + match Analysis.Packages.new_bs_package ~root_path with | None -> log_and_exit (Error diff --git a/tools/src/migrate.ml b/tools/src/migrate.ml index bfbb9f38783..30bba2094f7 100644 --- a/tools/src/migrate.ml +++ b/tools/src/migrate.ml @@ -745,14 +745,13 @@ let migrate ~entry_point_file ~output_mode = | true -> Unix.realpath entry_point_file | false -> entry_point_file in - let state = Shared_types.create_state () in let result = if Filename.check_suffix path ".res" then let parser = Res_driver.parsing_engine.parse_implementation ~for_printer:true in let {Res_driver.parsetree; comments; source} = parser ~filename:path in - match Cmt.load_cmt_infos_from_path ~state ~path with + match Cmt.load_cmt_infos_from_path ~path with | None -> Error (Printf.sprintf @@ -785,7 +784,7 @@ let migrate ~entry_point_file ~output_mode = parser ~filename:path in - match Cmt.load_cmt_infos_from_path ~state ~path with + match Cmt.load_cmt_infos_from_path ~path with | None -> Error (Printf.sprintf diff --git a/tools/src/tools.ml b/tools/src/tools.ml index 0da1e6f1a71..521d3f833f4 100644 --- a/tools/src/tools.ml +++ b/tools/src/tools.ml @@ -379,7 +379,6 @@ let extract_docs ~entry_point_file ~debug = | true -> Unix.realpath entry_point_file | false -> entry_point_file in - let state = Shared_types.create_state () in if debug then Printf.printf "extracting docs for %s\n" path; let result = match @@ -402,7 +401,7 @@ let extract_docs ~entry_point_file ~debug = else path else path in - match Cmt.load_full_cmt_from_path ~state ~path with + match Cmt.load_full_cmt_from_path ~path with | None -> Error (Printf.sprintf @@ -1004,7 +1003,6 @@ module Extract_codeblocks = struct let extract_code_blocks ~entry_point_file ~(process_docstrings : id:string -> name:string -> string -> unit) = - let state = Shared_types.create_state () in let path = match Filename.is_relative entry_point_file with | true -> Unix.realpath entry_point_file @@ -1026,7 +1024,7 @@ module Extract_codeblocks = struct if Sys.file_exists path_as_resi then path_as_resi else path else path in - match Cmt.load_full_cmt_from_path ~state ~path with + match Cmt.load_full_cmt_from_path ~path with | None -> Error (Printf.sprintf From 3be179c26194cd77a3039b6bfc88323a0c0e2f19 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Mon, 8 Jun 2026 20:26:48 -0300 Subject: [PATCH 34/37] analysis: add state_to_yojson --- analysis/src/shared_types.ml | 103 +++++++++++++++++++++++++++++++++++ 1 file changed, 103 insertions(+) diff --git a/analysis/src/shared_types.ml b/analysis/src/shared_types.ml index 173a6bfb7a7..ddecce94f10 100644 --- a/analysis/src/shared_types.ml +++ b/analysis/src/shared_types.ml @@ -965,3 +965,106 @@ let extract_exp_apply_args ~args = | [] -> List.rev acc in args |> process_args ~acc:[] + +let state_to_yojson (state : state) = + let option_to_yojson f = function + | None -> `Null + | Some value -> f value + in + + let string_set_to_yojson set = + `List (set |> File_set.elements |> List.map (fun value -> `String value)) + in + + let path_to_yojson path = `List (List.map (fun item -> `String item) path) in + + let paths_to_yojson = function + | Impl {cmt; res} -> + `Assoc + [("kind", `String "Impl"); ("cmt", `String cmt); ("res", `String res)] + | Namespace {cmt} -> + `Assoc [("kind", `String "Namespace"); ("cmt", `String cmt)] + | IntfAndImpl {cmti; resi; cmt; res} -> + `Assoc + [ + ("kind", `String "IntfAndImpl"); + ("cmti", `String cmti); + ("resi", `String resi); + ("cmt", `String cmt); + ("res", `String res); + ] + in + + let paths_for_module_to_yojson paths_for_module = + paths_for_module |> Hashtbl.to_seq + |> Seq.map (fun (file, paths) -> (file, paths_to_yojson paths)) + |> List.of_seq + |> fun fields -> `Assoc fields + in + + let autocomplete_to_yojson autocomplete = + autocomplete |> Misc.String_map.bindings + |> List.map (fun (name, files) -> + (name, `List (List.map (fun file -> `String file) files))) + |> fun fields -> `Assoc fields + in + + let package_to_yojson (package : package) = + let major, minor = package.rescript_version in + `Assoc + [ + ( "generic_jsx_module", + option_to_yojson + (fun value -> `String value) + package.generic_jsx_module ); + ("suffix", `String package.suffix); + ("root_path", `String package.root_path); + ("project_files", string_set_to_yojson package.project_files); + ("dependencies_files", string_set_to_yojson package.dependencies_files); + ("paths_for_module", paths_for_module_to_yojson package.paths_for_module); + ( "namespace", + option_to_yojson (fun value -> `String value) package.namespace ); + ("opens", `List (List.map path_to_yojson package.opens)); + ( "rescript_version", + `Assoc [("major", `Int major); ("minor", `Int minor)] ); + ("autocomplete", autocomplete_to_yojson package.autocomplete); + ] + in + + let file_to_yojson (file : File.t) = + `Assoc + [ + ("uri", `String (file.uri |> Lsp.Uri.to_string)); + ("module_name", `String file.module_name); + ("stamps_count", `Int (List.length (Stamps.get_entries file.stamps))); + ("structure_name", `String file.structure.name); + ( "structure_docstring", + `List (List.map (fun value -> `String value) file.structure.docstring) + ); + ("structure_items_count", `Int (List.length file.structure.items)); + ] + in + + let cmt_cache = + state.cmt_cache |> Hashtbl.to_seq + |> Seq.map (fun (file_path, file) -> (file_path, file_to_yojson file)) + |> List.of_seq + in + + let root_for_uri = + state.root_for_uri |> Hashtbl.to_seq |> List.of_seq + |> List.map (fun (uri, str) -> [(Lsp.Uri.to_string uri, `String str)]) + |> List.flatten + in + + let packages_by_root = + state.packages_by_root |> Hashtbl.to_seq |> List.of_seq + |> List.map (fun (root, package) -> (root, package_to_yojson package)) + in + + `Assoc + [ + ("cmt_cache", `Assoc cmt_cache); + ("root_for_uri", `Assoc root_for_uri); + ("packages_by_root", `Assoc packages_by_root); + ] From 9bc661c3bfdf3f8ebaac1964ca2d7fddccc66433 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Mon, 8 Jun 2026 20:28:01 -0300 Subject: [PATCH 35/37] lsp: refactor load_full - Add `package` to server state - Add to_yojson in state --- lsp/src/rescript_language_server.ml | 81 +++++++++++++++++++---------- lsp/src/state.ml | 53 ++++++++++++++++--- 2 files changed, 100 insertions(+), 34 deletions(-) diff --git a/lsp/src/rescript_language_server.ml b/lsp/src/rescript_language_server.ml index 1d8cf5e46a2..c69a7e070ad 100644 --- a/lsp/src/rescript_language_server.ml +++ b/lsp/src/rescript_language_server.ml @@ -91,24 +91,53 @@ let on_initialize (params : InitializeParams.t) (server : State.t Server.t) = in let state = State.initialize state ~params ~diagnostics in let initialization_info = initialization params.capabilities in + + let package = + Analysis.Packages.new_bs_package + ~root_path:(State.workspace_root state |> Uri.to_path) + in + + let state = {state with package} in + (initialization_info, state) let on_request (Client_request.E request) (server : State.t Server.t) = - let state = Server.state server in - let analysis_state = state.analysis_state in - let load_full uri = - Analysis.Cmt.load_full_cmt_from_path ~state:analysis_state - ~path:(DocumentUri.to_path uri) + let load_full uri (state : State.t) = + match state.status with + | Initialized _ -> ( + let path = uri |> Uri.to_path in + match state.package with + | Some package -> ( + let module_name = + Analysis.Build_system.namespaced_name package.namespace + (Analysis.Find_files.get_name path) + in + match + Analysis.Cmt.full_for_incremental_cmt ~package ~module_name ~uri + with + | Some cmt_info -> Some cmt_info + | None -> ( + match Hashtbl.find_opt package.paths_for_module module_name with + | Some paths -> + let cmt = Analysis.Shared_types.get_cmt_path ~uri paths in + Analysis.Cmt.full_for_cmt ~module_name ~package ~uri cmt + | None -> None)) + | None -> None) + | Uninitialized -> None in + let ok value = Ok (Client_request.yojson_of_result request value) in + let state = Server.state server in + let analysis_state = state.analysis_state in + match request with | Client_request.Initialize params -> let initialization_info, state = on_initialize params server in (ok initialization_info, state) | TextDocumentHover {position; textDocument = {uri}} -> let source = (Document_store.get ~uri state.store).text in - let full = load_full uri in + let full = load_full uri state in let hover = Analysis.Commands.hover ~state:analysis_state ~source ~kind_file:(Document.kind uri) @@ -120,7 +149,7 @@ let on_request (Client_request.E request) (server : State.t Server.t) = (ok hover, state) | TextDocumentCompletion {textDocument = {uri}; position} -> let source = (Document_store.get ~uri state.store).text in - let full = load_full uri in + let full = load_full uri state in let comp = Analysis.Commands.completion ~state:analysis_state ~debug:false ~source ~kind_file:(Document.kind uri) @@ -140,10 +169,7 @@ let on_request (Client_request.E request) (server : State.t Server.t) = let module_path = List.assoc_opt "modulePath" fields in match (file_path, module_path) with | Some (`String file_path), Some (`String module_path) -> - let full = - Analysis.Cmt.load_full_cmt_from_path ~state:analysis_state - ~path:file_path - in + let full = load_full (Uri.of_path file_path) state in let documentation = Analysis.Commands.completion_resolve ~state:analysis_state ~full ~module_path @@ -156,7 +182,7 @@ let on_request (Client_request.E request) (server : State.t Server.t) = (ok (resp |> Option.value ~default:item), state) | SignatureHelp {textDocument = {uri}; position} -> let source = (Document_store.get ~uri state.store).text in - let full = load_full uri in + let full = load_full uri state in let resp = match Analysis.Commands.signature_help ~state:analysis_state ~source @@ -169,7 +195,7 @@ let on_request (Client_request.E request) (server : State.t Server.t) = in (ok resp, state) | TextDocumentDefinition {textDocument = {uri}; position} -> - let full = load_full uri in + let full = load_full uri state in let resp = match Analysis.Commands.definition ~state:analysis_state ~full @@ -181,7 +207,7 @@ let on_request (Client_request.E request) (server : State.t Server.t) = in (ok resp, state) | TextDocumentTypeDefinition {textDocument = {uri}; position} -> - let full = load_full uri in + let full = load_full uri state in let resp = match Analysis.Commands.type_definition ~state:analysis_state ~full @@ -193,7 +219,7 @@ let on_request (Client_request.E request) (server : State.t Server.t) = in (ok resp, state) | TextDocumentReferences {textDocument = {uri}; position} -> - let full = load_full uri in + let full = load_full uri state in let resp = Analysis.Commands.references ~state:analysis_state ~full ~pos:(position.line, position.character) @@ -203,7 +229,7 @@ let on_request (Client_request.E request) (server : State.t Server.t) = | DocumentSymbol {textDocument = {uri}} -> ( (* NOTE: Client side bug. For some reason, Neovim requests the document symbol before sending the TextDocumentDidOpen notification. *) match Document_store.get_opt ~uri state.store with - | None -> (ok None, state) + | None -> (ok (Some (`DocumentSymbol [])), state) | Some {text} -> let resp = Analysis.Document_symbol.get_symbols ~source:text @@ -223,7 +249,7 @@ let on_request (Client_request.E request) (server : State.t Server.t) = (ok (Some resp), state) | TextDocumentCodeLens {textDocument = {uri}} -> let source = (Document_store.get ~uri state.store).text in - let full = load_full uri in + let full = load_full uri state in let resp = Analysis.Hint.code_lens ~source ~kind_file:(Document.kind uri) ~full ~debug:false @@ -231,9 +257,10 @@ let on_request (Client_request.E request) (server : State.t Server.t) = (ok (resp |> Option.value ~default:[]), state) | InlayHint {textDocument = {uri}; range = {start; end_}} -> let source = (Document_store.get ~uri state.store).text in - let full = load_full uri in + let full = load_full uri state in let resp = - Analysis.Hint.inlay ~source ~kind_file:(Document.kind uri) ~full + Analysis.Hint.inlay ~state:analysis_state ~source + ~kind_file:(Document.kind uri) ~full ~pos:(start.line, end_.line) (* TODO: max_length should be a config *) ~max_length:(string_of_int 25) ~debug:false in @@ -246,7 +273,7 @@ let on_request (Client_request.E request) (server : State.t Server.t) = in (ok (Some resp), state) | TextDocumentRename {textDocument = {uri}; position; newName} -> - let full = load_full uri in + let full = load_full uri state in let resp = match Analysis.Commands.rename ~state:analysis_state ~full @@ -258,10 +285,10 @@ let on_request (Client_request.E request) (server : State.t Server.t) = in (ok resp, state) | TextDocumentPrepareRename {textDocument = {uri}; position} -> - let full = load_full uri in + let full = load_full uri state in let resp = match - Analysis.Commands.prepare_rename ~state:analysis_state ~full + Analysis.Commands.prepare_rename ~full ~pos:(position.line, position.character) ~debug:false with @@ -273,10 +300,7 @@ let on_request (Client_request.E request) (server : State.t Server.t) = let source = (Document_store.get ~uri state.store).text in let resp = - match - Analysis.Commands.format ~state:analysis_state ~source - ~kind_file:(Document.kind uri) - with + match Analysis.Commands.format ~source ~kind_file:(Document.kind uri) with | Ok text_edit -> Some text_edit | Error _ -> None in @@ -400,5 +424,8 @@ let on_notification notification (server : State.t Server.t) = state let listen ~input ~output ~fs = - let state = State.create ~store:(Document_store.create ()) ~fs in + let state = + State.create ~store:(Document_store.create ()) ~fs ~package:None + ~analysis_state:(Analysis.Shared_types.create_state ()) + in Server.listen ~input ~output ~on_request ~on_notification ~state diff --git a/lsp/src/state.ml b/lsp/src/state.ml index 6098515bf5e..31b2b60b81e 100644 --- a/lsp/src/state.ml +++ b/lsp/src/state.ml @@ -9,15 +9,11 @@ type t = { store: Document_store.t; fs: Eio.Fs.dir_ty Eio.Path.t; analysis_state: Analysis.Shared_types.state; + package: Analysis.Shared_types.package option; } -let create ~store ~fs = - { - status = Uninitialized; - store; - fs; - analysis_state = Analysis.Shared_types.create_state (); - } +let create ~store ~fs ~package ~analysis_state = + {status = Uninitialized; store; fs; package; analysis_state} let initialize t ~params ~diagnostics = {t with status = Initialized {params; diagnostics}} @@ -41,3 +37,46 @@ let workspace_root t = match init.params.rootUri with | None -> assert false | Some uri -> uri) + +let to_yojson (t : t) : Yojson.Safe.t = + let document_store_to_yojson (store : Document_store.t) = + store.documents |> Hashtbl.to_seq + |> Seq.map (fun (uri, {Document_store.text; version}) -> + ( Lsp.Uri.to_string uri, + `Assoc + [ + ("version", `Int version); + ("text_length", `Int (String.length text)); + (* ("text", `String text); *) + ] )) + |> List.of_seq + |> fun fields -> `Assoc fields + in + + let diagnostics_to_yojson (diagnostics : Diagnostics.t) = + diagnostics.diagnostics |> Diagnostics.Uri_map.to_seq + |> Seq.map (fun (uri, diagnostics) -> + ( Lsp.Uri.to_string uri, + `List (List.map Diagnostic.yojson_of_t diagnostics) )) + |> List.of_seq + |> fun fields -> `Assoc fields + in + + let status_to_yojson = function + | Uninitialized -> `Assoc [("kind", `String "Uninitialized")] + | Initialized {diagnostics} -> + `Assoc + [ + ("kind", `String "Initialized"); + (* ("params", InitializeParams.yojson_of_t params); *) + ("diagnostics", diagnostics_to_yojson diagnostics); + ] + in + + `Assoc + [ + ("status", status_to_yojson t.status); + ("store", document_store_to_yojson t.store); + ("fs", `String ""); + (* ("analysis_state", Analysis.Shared_types.state_to_yojson t.analysis_state); *) + ] From 8ec52ae1609ba834210e7a1e4d8049e796e70b1c Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Mon, 8 Jun 2026 23:11:58 -0300 Subject: [PATCH 36/37] add minimal param to State.to_yojson --- lsp/src/state.ml | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/lsp/src/state.ml b/lsp/src/state.ml index 31b2b60b81e..321ed9dcc31 100644 --- a/lsp/src/state.ml +++ b/lsp/src/state.ml @@ -38,17 +38,17 @@ let workspace_root t = | None -> assert false | Some uri -> uri) -let to_yojson (t : t) : Yojson.Safe.t = +let to_yojson ?(minimal : bool = true) (t : t) : Yojson.Safe.t = let document_store_to_yojson (store : Document_store.t) = store.documents |> Hashtbl.to_seq |> Seq.map (fun (uri, {Document_store.text; version}) -> ( Lsp.Uri.to_string uri, `Assoc - [ - ("version", `Int version); - ("text_length", `Int (String.length text)); - (* ("text", `String text); *) - ] )) + ([ + ("version", `Int version); + ("text_length", `Int (String.length text)); + ] + @ if not minimal then [("text", `String text)] else []) )) |> List.of_seq |> fun fields -> `Assoc fields in @@ -64,19 +64,20 @@ let to_yojson (t : t) : Yojson.Safe.t = let status_to_yojson = function | Uninitialized -> `Assoc [("kind", `String "Uninitialized")] - | Initialized {diagnostics} -> + | Initialized {params; diagnostics} -> `Assoc - [ - ("kind", `String "Initialized"); - (* ("params", InitializeParams.yojson_of_t params); *) - ("diagnostics", diagnostics_to_yojson diagnostics); - ] + ([ + ("kind", `String "Initialized"); + ("diagnostics", diagnostics_to_yojson diagnostics); + ] + @ + if not minimal then [("params", InitializeParams.yojson_of_t params)] + else []) in `Assoc [ ("status", status_to_yojson t.status); ("store", document_store_to_yojson t.store); - ("fs", `String ""); - (* ("analysis_state", Analysis.Shared_types.state_to_yojson t.analysis_state); *) + ("analysis_state", Analysis.Shared_types.state_to_yojson t.analysis_state); ] From 22a5eebe14299a3244125618b382746ad6f99eb9 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Mon, 8 Jun 2026 23:31:10 -0300 Subject: [PATCH 37/37] Makefile: skip test on Windows and update ci --- .github/workflows/ci.yml | 3 +-- Makefile | 6 +++++- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 26d60bddccf..6fe976f06b9 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -377,10 +377,9 @@ jobs: if: runner.os != 'Windows' run: make -C tests/gentype_tests/typescript-react-example clean test - # Skip tests on Windows because OCaml Eio process operations is not supported on Windows yet + # The Makefile skip some tests on Windows because OCaml Eio process operations is not supported on Windows yet # Eio.Stdenv.process_mgr raise a error, see https://github.com/ocaml-multicore/eio/blob/37d6e67f7e25b43e4a66574ed98838c79f1a21b4/lib_eio_windows/eio_windows.ml#L36 - name: Run LSP tests - if: runner.os != 'Windows' run: opam exec -- make test-lsp # On Windows, after running setup-ocaml (if it wasn't cached yet or the cache couldn't be restored), diff --git a/Makefile b/Makefile index 7f726bede6a..801e1457961 100644 --- a/Makefile +++ b/Makefile @@ -183,7 +183,11 @@ test-lsp: lib ( cd "$$dir" && yarn clean && yarn build ); \ done @dune runtest - @dune exec -- lsp-tests + @if [ "$$OS" = "Windows_NT" ]; then \ + echo "Skipping lsp-tests executable on Windows"; \ + else \ + dune exec -- lsp-tests; \ + fi @if [ -n "$$(git ls-files --modified tests/lsp_tests/**/*.expected)" ]; then \ echo "The lsp_tests snapshot doesn't match. Double check that the output is correct, run 'make test-lsp' and stage the diff"; \ git --no-pager diff tests/lsp_tests/**/*.expected; \