fix: merlin diagnostics and watch mode (#1005)

Updating the document with no changes is no longer needed because we
don't reuse the pipeline.

This also fixes a bug whenever we're editing a document and dune is
running in watch mode. The issue was that we were updating a document
the store in the background and overwriting updates to the document
requested by the user.

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

CHANGES.md

@@ -1,3 +1,10 @@
+# Unreleased
+
+## Fixes
+
+- Fix race condition when a document was being edited and dune in watch mode
+  was running (#1004, fixes #941, #1003)
+
 # 1.15.0-4.14
 
 ## Features

ocaml-lsp-server/src/document.ml

@@ -128,22 +128,15 @@ module Single_pipeline : sig
     -> 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
-    }
+  type t = { thread : Lev_fiber.Thread.t } [@@unboxed]
 
-  let create thread = { thread; last = None }
+  let create thread = { thread }
 
   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
+      let source = Msource.make (Text_document.text doc) in
+      fun () -> Mpipeline.make config source
     in
     let task =
       match
@@ -152,15 +145,15 @@ end = struct
             let pipeline = make_pipeline () in
             let res = Mpipeline.with_pipeline pipeline (fun () -> f pipeline) in
             let stop = Unix.time () in
-            (res, pipeline, start, stop))
+            (res, 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) ->
+    | Ok (res, start, stop) ->
       let event =
         let module Event = Chrome_trace.Event in
         let dur = Event.Timestamp.of_float_seconds (stop -. start) in
@@ -172,7 +165,6 @@ end = struct
         in
         Event.complete ~dur fields
       in
-      t.last <- Some (doc, config, pipeline);
       let+ () = Metrics.report event in
       Ok res
 end

ocaml-lsp-server/src/document_store.ml

@@ -190,19 +190,12 @@ let get_semantic_tokens_cache : t -> Uri.t -> semantic_tokens_cache option =
   let doc = get' t uri in
   doc.semantic_tokens_cache
 
-let change_all t ~f =
-  let all =
-    Table.foldi ~init:[] t.db ~f:(fun uri doc acc -> (uri, doc) :: acc)
-  in
-  Fiber.parallel_iter all ~f:(fun (uri, doc) ->
-      let+ doc =
-        match doc.document with
-        | None -> Fiber.return doc
-        | Some document ->
-          let+ document = f document in
-          { doc with document = Some document }
-      in
-      Table.set t.db uri doc)
+let parallel_iter t ~f =
+  let all = Table.fold ~init:[] t.db ~f:(fun doc acc -> doc :: acc) in
+  Fiber.parallel_iter all ~f:(fun doc ->
+      match doc.document with
+      | None -> Fiber.return ()
+      | Some document -> f document)
 
 let fold t ~init ~f =
   Table.fold t.db ~init ~f:(fun doc acc ->

ocaml-lsp-server/src/document_store.mli

@@ -30,6 +30,6 @@ val close_document : t -> Uri.t -> unit Fiber.t
 
 val fold : t -> init:'acc -> f:(Document.t -> 'acc -> 'acc) -> 'acc
 
-val change_all : t -> f:(Document.t -> Document.t Fiber.t) -> unit Fiber.t
+val parallel_iter : t -> f:(Document.t -> unit Fiber.t) -> unit Fiber.t
 
 val close_all : t -> unit Fiber.t

ocaml-lsp-server/src/dune.ml

@@ -263,15 +263,11 @@ end = struct
                   match p with
                   | Failed | Interrupted | Success ->
                     let* () =
-                      Document_store.change_all document_store ~f:(fun doc ->
+                      Document_store.parallel_iter document_store ~f:(fun doc ->
                           match Document.kind doc with
-                          | `Other -> Fiber.return doc
+                          | `Other -> Fiber.return ()
                           | `Merlin merlin ->
-                            let doc = Document.update_text doc [] in
-                            let+ () =
-                              Diagnostics.merlin_diagnostics diagnostics merlin
-                            in
-                            doc)
+                            Diagnostics.merlin_diagnostics diagnostics merlin)
                     in
                     Diagnostics.send diagnostics `All
                   | _ -> Fiber.return ())

ocaml-lsp-server/src/ocaml_lsp_server.ml

@@ -758,13 +758,7 @@ let on_notification server (notification : Client_notification.t) :
       ( Log.log ~section:"on receive DidSaveTextDocument" @@ fun () ->
         Log.msg "saved document is not in the store" [] );
       Fiber.return state
-    | Some _ ->
-      let doc =
-        Document_store.change_document store uri ~f:(fun doc ->
-            (* we need [update_text] with no changes to get a new merlin
-               pipeline; otherwise the diagnostics don't get updated *)
-            Document.update_text doc [])
-      in
+    | Some doc ->
       let+ () = set_diagnostics state.detached (State.diagnostics state) doc in
       state)
   | ChangeWorkspaceFolders change ->