From d1507c67d1c985230c966a1fb27a903a9008ce3e Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 3 Nov 2022 21:32:24 -0600 Subject: [PATCH] fix: correctly use merlin's pipeline do not reuse pipelines unless we are using the same pipeline multiple times in a row Signed-off-by: Rudi Grinberg ps-id: 383efc92-8d86-4d09-b01a-16fcf8c0a0d0 --- CHANGES.md | 2 + ocaml-lsp-server/src/document.ml | 178 ++++++++++-------- ocaml-lsp-server/src/document.mli | 8 +- ocaml-lsp-server/src/inference.ml | 2 +- ocaml-lsp-server/src/ocaml_lsp_server.ml | 6 +- ocaml-lsp-server/src/state.ml | 4 +- ocaml-lsp-server/src/state.mli | 2 +- ocaml-lsp-server/test/e2e-new/code_actions.ml | 11 +- 8 files changed, 118 insertions(+), 95 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index a3201900a..a0577ae07 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,8 @@ ## Fixes +- Fix random requests failing after switching documents (#904, fixes #898) + - Do not offer related diagnostic information unless the user enables in client capabilities (#905) diff --git a/ocaml-lsp-server/src/document.ml b/ocaml-lsp-server/src/document.ml index 9e15b6704..2f2bc921e 100644 --- a/ocaml-lsp-server/src/document.ml +++ b/ocaml-lsp-server/src/document.ml @@ -86,36 +86,6 @@ module Syntax = struct | None -> Text_document.documentUri td |> Uri.to_path |> of_fname end -type merlin = - { tdoc : Text_document.t - ; pipeline : Mpipeline.t Lazy_fiber.t - ; merlin : Lev_fiber.Thread.t - ; timer : Lev_fiber.Timer.Wheel.task - ; merlin_config : Merlin_config.t - ; syntax : Syntax.t - } - -type t = - | Other of - { tdoc : Text_document.t - ; syntax : Syntax.t - } - | Merlin of merlin - -let tdoc = function - | Other d -> d.tdoc - | Merlin m -> m.tdoc - -let uri t = Text_document.documentUri (tdoc t) - -let syntax = function - | Merlin m -> m.syntax - | Other t -> t.syntax - -let text t = Text_document.text (tdoc t) - -let source t = Msource.make (text t) - let await task = let* cancel_token = Server.cancel_token () in let f () = Lev_fiber.Thread.await task in @@ -146,40 +116,112 @@ let await task = in raise (Jsonrpc.Response.Error.E e)) -let version t = Text_document.version (tdoc t) +module Single_pipeline : sig + type t + + val create : Lev_fiber.Thread.t -> t -let make_pipeline merlin_config thread tdoc = - Lazy_fiber.create (fun () -> - let* config = Merlin_config.config merlin_config in - let* async_make_pipeline = - match - Lev_fiber.Thread.task thread ~f:(fun () -> - Text_document.text tdoc |> Msource.make |> Mpipeline.make config) - with - | Error `Stopped -> Fiber.never - | Ok task -> Fiber.return task + val use : + t + -> doc:Text_document.t + -> config:Merlin_config.t + -> f:(Mpipeline.t -> 'a) + -> ('a, Exn_with_backtrace.t) result Fiber.t +end = struct + type t = + { thread : Lev_fiber.Thread.t + ; mutable last : (Text_document.t * Mconfig.t * Mpipeline.t) option + } + + let create thread = { thread; last = None } + + let use t ~doc ~config ~f = + let* config = Merlin_config.config config in + let make_pipeline = + match t.last with + | Some (doc', config', pipeline) when doc' == doc && config == config' -> + fun () -> pipeline + | _ -> + let source = Msource.make (Text_document.text doc) in + fun () -> Mpipeline.make config source + in + let task = + match + Lev_fiber.Thread.task t.thread ~f:(fun () -> + let start = Unix.time () in + let pipeline = make_pipeline () in + let res = Mpipeline.with_pipeline pipeline (fun () -> f pipeline) in + let stop = Unix.time () in + (res, pipeline, start, stop)) + with + | Error `Stopped -> assert false + | Ok task -> task + in + let* res = await task in + match res with + | Error exn -> Fiber.return (Error exn) + | Ok (res, pipeline, start, stop) -> + let event = + let module Event = Chrome_trace.Event in + let dur = Event.Timestamp.of_float_seconds (stop -. start) in + let fields = + Event.common_fields + ~ts:(Event.Timestamp.of_float_seconds start) + ~name:"merlin" + () + in + Event.complete ~dur fields in - let+ res = await async_make_pipeline in - match res with - | Ok s -> s - | Error e -> Exn_with_backtrace.reraise e) + t.last <- Some (doc, config, pipeline); + let+ () = Metrics.report event in + Ok res +end -let make_merlin wheel merlin_db ~merlin_thread tdoc syntax = +type merlin = + { tdoc : Text_document.t + ; pipeline : Single_pipeline.t + ; timer : Lev_fiber.Timer.Wheel.task + ; merlin_config : Merlin_config.t + ; syntax : Syntax.t + } + +type t = + | Other of + { tdoc : Text_document.t + ; syntax : Syntax.t + } + | Merlin of merlin + +let tdoc = function + | Other d -> d.tdoc + | Merlin m -> m.tdoc + +let uri t = Text_document.documentUri (tdoc t) + +let syntax = function + | Merlin m -> m.syntax + | Other t -> t.syntax + +let text t = Text_document.text (tdoc t) + +let source t = Msource.make (text t) + +let version t = Text_document.version (tdoc t) + +let make_merlin wheel merlin_db pipeline tdoc syntax = let+ timer = Lev_fiber.Timer.Wheel.task wheel in let merlin_config = let uri = Text_document.documentUri tdoc in Merlin_config.DB.get merlin_db uri in - let pipeline = make_pipeline merlin_config merlin_thread tdoc in - Merlin - { merlin_config; tdoc; pipeline; merlin = merlin_thread; timer; syntax } + Merlin { merlin_config; tdoc; pipeline; timer; syntax } -let make wheel config ~merlin_thread (doc : DidOpenTextDocumentParams.t) = +let make wheel config pipeline (doc : DidOpenTextDocumentParams.t) = Fiber.of_thunk (fun () -> let tdoc = Text_document.make doc in let syntax = Syntax.of_text_document tdoc in match syntax with - | Ocaml | Reason -> make_merlin wheel config ~merlin_thread tdoc syntax + | Ocaml | Reason -> make_merlin wheel config pipeline tdoc syntax | Ocamllex | Menhir | Cram | Dune -> Fiber.return (Other { tdoc; syntax })) let update_text ?version t changes = @@ -200,9 +242,7 @@ let update_text ?version t changes = | tdoc -> ( match t with | Other o -> Other { o with tdoc } - | Merlin ({ merlin_config; merlin; _ } as t) -> - let pipeline = make_pipeline merlin_config merlin tdoc in - Merlin { t with tdoc; pipeline }) + | Merlin t -> Merlin { t with tdoc }) module Merlin = struct type t = merlin @@ -216,35 +256,7 @@ module Merlin = struct let kind t = Kind.of_fname (Uri.to_path (uri (Merlin t))) let with_pipeline (t : t) f = - let* pipeline = Lazy_fiber.force t.pipeline in - let* task = - match - Lev_fiber.Thread.task t.merlin ~f:(fun () -> - let start = Unix.time () in - let res = Mpipeline.with_pipeline pipeline (fun () -> f pipeline) in - let stop = Unix.time () in - let event = - let module Event = Chrome_trace.Event in - let dur = Event.Timestamp.of_float_seconds (stop -. start) in - let fields = - Event.common_fields - ~ts:(Event.Timestamp.of_float_seconds start) - ~name:"merlin" - () - in - Event.complete ~dur fields - in - (event, res)) - with - | Error `Stopped -> Fiber.never - | Ok task -> Fiber.return task - in - let* res = await task in - match res with - | Ok (event, result) -> - let+ () = Metrics.report event in - Ok result - | Error e -> Fiber.return (Error e) + Single_pipeline.use t.pipeline ~doc:t.tdoc ~config:t.merlin_config ~f let with_pipeline_exn doc f = let+ res = with_pipeline doc f in diff --git a/ocaml-lsp-server/src/document.mli b/ocaml-lsp-server/src/document.mli index 1a406f014..55128514c 100644 --- a/ocaml-lsp-server/src/document.mli +++ b/ocaml-lsp-server/src/document.mli @@ -24,10 +24,16 @@ end val syntax : t -> Syntax.t +module Single_pipeline : sig + type t + + val create : Lev_fiber.Thread.t -> t +end + val make : Lev_fiber.Timer.Wheel.t -> Merlin_config.DB.t - -> merlin_thread:Lev_fiber.Thread.t + -> Single_pipeline.t -> DidOpenTextDocumentParams.t -> t Fiber.t diff --git a/ocaml-lsp-server/src/inference.ml b/ocaml-lsp-server/src/inference.ml index 8edc4ddf0..a85852c16 100644 --- a/ocaml-lsp-server/src/inference.ml +++ b/ocaml-lsp-server/src/inference.ml @@ -56,7 +56,7 @@ let open_document_from_file (state : State.t) uri = Document.make (State.wheel state) state.merlin_config - ~merlin_thread:state.merlin + state.merlin params in Some doc) diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index d09aaae35..dbd476862 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -906,11 +906,7 @@ let on_notification server (notification : Client_notification.t) : match notification with | TextDocumentDidOpen params -> let* doc = - Document.make - (State.wheel state) - state.merlin_config - params - ~merlin_thread:state.merlin + Document.make (State.wheel state) state.merlin_config state.merlin params in assert (Document_store.get_opt store params.textDocument.uri = None); let* () = Document_store.open_document store doc in diff --git a/ocaml-lsp-server/src/state.ml b/ocaml-lsp-server/src/state.ml index e4baf6fdf..c5ddcdfe7 100644 --- a/ocaml-lsp-server/src/state.ml +++ b/ocaml-lsp-server/src/state.ml @@ -12,7 +12,7 @@ type init = type t = { store : Document_store.t - ; merlin : Lev_fiber.Thread.t + ; merlin : Document.Single_pipeline.t ; merlin_config : Merlin_config.DB.t ; init : init ; detached : Fiber.Pool.t @@ -28,7 +28,7 @@ let create ~store ~merlin ~detached ~configuration ~ocamlformat_rpc { init = Uninitialized ; merlin_config = Merlin_config.DB.create () ; store - ; merlin + ; merlin = Document.Single_pipeline.create merlin ; detached ; configuration ; trace = Off diff --git a/ocaml-lsp-server/src/state.mli b/ocaml-lsp-server/src/state.mli index 2231f3767..505ad23a4 100644 --- a/ocaml-lsp-server/src/state.mli +++ b/ocaml-lsp-server/src/state.mli @@ -12,7 +12,7 @@ type init = type t = { store : Document_store.t - ; merlin : Lev_fiber.Thread.t + ; merlin : Document.Single_pipeline.t ; merlin_config : Merlin_config.DB.t ; init : init ; detached : Fiber.Pool.t diff --git a/ocaml-lsp-server/test/e2e-new/code_actions.ml b/ocaml-lsp-server/test/e2e-new/code_actions.ml index 7142e2feb..c69138cca 100644 --- a/ocaml-lsp-server/test/e2e-new/code_actions.ml +++ b/ocaml-lsp-server/test/e2e-new/code_actions.ml @@ -1,8 +1,14 @@ open Test.Import let iter_code_actions ?(path = "foo.ml") ~source range k = + let diagnostics = Fiber.Ivar.create () in let handler = - Client.Handler.make ~on_notification:(fun _ _ -> Fiber.return ()) () + Client.Handler.make + ~on_notification: + (fun _ -> function + | PublishDiagnostics _ -> Fiber.Ivar.fill diagnostics () + | _ -> Fiber.return ()) + () in Test.run ~handler @@ fun client -> let run_client () = @@ -38,7 +44,8 @@ let iter_code_actions ?(path = "foo.ml") ~source range k = in k resp in - Fiber.fork_and_join_unit run_client (fun () -> run >>> Client.stop client) + Fiber.fork_and_join_unit run_client (fun () -> + run >>> Fiber.Ivar.read diagnostics >>> Client.stop client) let print_code_actions ?(path = "foo.ml") source range = iter_code_actions ~path ~source range (function