Clear diagnostics for non-project files

CHANGES.md

@@ -6,6 +6,7 @@
 
 - #268: Do not use vendored libraries when building the lsp package (#260)
 
+- #271: Clear diagnostics when files are closed
 
 # 1.1.0 (10/14/2020)
 

ocaml-lsp-server/src/ocaml_lsp_server.ml

@@ -59,74 +59,80 @@ let initialize_info : InitializeResult.t =
 
 let ocamlmerlin_reason = "ocamlmerlin-reason"
 
-let send_diagnostics rpc doc =
+let send_diagnostics ?diagnostics rpc doc =
   let state : State.t = Server.state rpc in
-  let send () =
-    let diagnostic_create = Diagnostic.create ~source:"ocamllsp" in
-    let available =
-      match Document.syntax doc with
-      | Menhir
-      | Ocamllex ->
-        `Unsupported
-      | Ocaml -> `Available true
-      | Reason -> `Available (Option.is_some (Bin.which ocamlmerlin_reason))
-    in
-    let uri = Document.uri doc |> Lsp.Uri.to_string in
-    match available with
-    | `Unsupported -> Fiber.return ()
-    | `Available false ->
-      let notif =
-        let diagnostics =
-          let message =
-            sprintf "Could not detect %s. Please install reason"
-              ocamlmerlin_reason
-          in
-          let range =
-            let pos = Position.create ~line:1 ~character:1 in
-            Range.create ~start:pos ~end_:pos
+  let uri = Document.uri doc |> Lsp.Uri.to_string in
+  let create_diagnostic ?severity range message =
+    Diagnostic.create ?severity ~range ~message ~source:"ocamllsp" ()
+  in
+  let create_publishDiagnostics uri diagnostics =
+    Server_notification.PublishDiagnostics
+      (PublishDiagnosticsParams.create ~uri ~diagnostics ())
+  in
+  let async send =
+    Scheduler.detach state.scheduler (fun () ->
+        let open Fiber.O in
+        let timer = Document.timer doc in
+        let+ res = Scheduler.schedule timer send in
+        match res with
+        | Error `Cancelled
+        | Ok () ->
+          ())
+  in
+  match diagnostics with
+  | Some diagnostics ->
+    async (fun () ->
+        let notif = create_publishDiagnostics uri diagnostics in
+        Server.notification rpc notif)
+  | None -> (
+    match Document.syntax doc with
+    | Menhir
+    | Ocamllex ->
+      Fiber.return ()
+    | Reason when Option.is_none (Bin.which ocamlmerlin_reason) ->
+      async (fun () ->
+          let no_reason_merlin =
+            let message =
+              sprintf "Could not detect %s. Please install reason"
+                ocamlmerlin_reason
+            in
+            let range =
+              let pos = Position.create ~line:1 ~character:1 in
+              Range.create ~start:pos ~end_:pos
+            in
+            create_diagnostic range message
           in
-          [ diagnostic_create ~range ~message () ]
-        in
-        Server_notification.PublishDiagnostics
-          (PublishDiagnosticsParams.create ~uri ~diagnostics ())
-      in
-      Server.notification rpc notif
-    | `Available true ->
-      let open Fiber.O in
-      let* diagnostics =
-        Document.with_pipeline_exn doc @@ fun pipeline ->
-        let command =
-          Query_protocol.Errors { lexing = true; parsing = true; typing = true }
-        in
-        let errors = Query_commands.dispatch pipeline command in
-        List.map errors ~f:(fun (error : Loc.error) ->
-            let loc = Loc.loc_of_report error in
-            let range = Range.of_loc loc in
-            let severity =
-              match error.source with
-              | Warning -> DiagnosticSeverity.Warning
-              | _ -> DiagnosticSeverity.Error
+          let notif = create_publishDiagnostics uri [ no_reason_merlin ] in
+          Server.notification rpc notif)
+    | Reason
+    | Ocaml ->
+      async (fun () ->
+          let open Fiber.O in
+          let* diagnostics =
+            let command =
+              Query_protocol.Errors
+                { lexing = true; parsing = true; typing = true }
             in
-            let message =
-              Loc.print_main Format.str_formatter error;
-              String.trim (Format.flush_str_formatter ())
+            let+ errors =
+              Document.with_pipeline_exn doc (fun pipeline ->
+                  Query_commands.dispatch pipeline command)
             in
-            diagnostic_create ~range ~message ~severity ())
-      in
-      let notif =
-        Server_notification.PublishDiagnostics
-          (PublishDiagnosticsParams.create ~uri ~diagnostics ())
-      in
-      Server.notification rpc notif
-  in
-  Scheduler.detach state.scheduler (fun () ->
-      let open Fiber.O in
-      let timer = Document.timer doc in
-      let+ res = Scheduler.schedule timer send in
-      match res with
-      | Error `Cancelled
-      | Ok () ->
-        ())
+            List.map errors ~f:(fun (error : Loc.error) ->
+                let loc = Loc.loc_of_report error in
+                let range = Range.of_loc loc in
+                let severity =
+                  match error.source with
+                  | Warning -> DiagnosticSeverity.Warning
+                  | _ -> DiagnosticSeverity.Error
+                in
+                let message =
+                  Loc.print_main Format.str_formatter error;
+                  String.trim (Format.flush_str_formatter ())
+                in
+                create_diagnostic range message ~severity)
+          in
+          let notif = create_publishDiagnostics uri diagnostics in
+          Server.notification rpc notif) )
 
 let on_initialize rpc =
   let log_consumer (section, title, text) =
@@ -665,6 +671,10 @@ let on_notification server (notification : Client_notification.t) :
     Fiber.return state
   | TextDocumentDidClose { textDocument = { uri } } ->
     let uri = Uri.t_of_yojson (`String uri) in
+    let doc = Document_store.get_opt store uri in
+    let _clear_diagnostics : unit Fiber.t =
+      send_diagnostics ~diagnostics:[] server (Option.value_exn doc)
+    in
     let open Fiber.O in
     let+ () = Document_store.remove_document store uri in
     state