fix: handle incorrect document types

instead of crashing, we return no code actions

Signed-off-by: Rudi Grinberg <[email protected]>

ps-id: 5f932001-91c4-4ab8-97ce-3460e4001c2a

CHANGES.md

@@ -1,6 +1,9 @@
-# Unreleased
+# 1.14.1
 
-## Features
+## Fixes
+
+- Do no crash server when code actions when merlin code actions are asked for
+  merlin documents (#884, fixes #871)
 
 - Ignore unknown tags in merlin configuration to improve forward compatibility
   with Dune. (#883)

ocaml-lsp-server/src/code_actions/action_construct.ml

@@ -5,8 +5,8 @@ let action_kind = "construct"
 
 let code_action doc (params : CodeActionParams.t) =
   match Document.kind doc with
-  | Intf -> Fiber.return None
-  | Impl ->
+  | `Other | `Merlin Intf -> Fiber.return None
+  | `Merlin Impl ->
     let pos = Position.logical params.range.Range.end_ in
     (* we want this predicate to quickly eliminate prefixes that don't fit to be
        a hole *)

ocaml-lsp-server/src/code_actions/action_destruct.ml

@@ -40,8 +40,8 @@ let code_action_of_case_analysis ~supportsJumpToNextHole doc uri (loc, newText)
 let code_action (state : State.t) doc (params : CodeActionParams.t) =
   let uri = params.textDocument.uri in
   match Document.kind doc with
-  | Intf -> Fiber.return None
-  | Impl -> (
+  | `Other | `Merlin Intf -> Fiber.return None
+  | `Merlin Impl -> (
     let command =
       let start = Position.logical params.range.start in
       let finish = Position.logical params.range.end_ in

ocaml-lsp-server/src/code_actions/action_inferred_intf.ml

@@ -26,8 +26,8 @@ let code_action_of_intf doc intf range =
 
 let code_action (state : State.t) doc (params : CodeActionParams.t) =
   match Document.kind doc with
-  | Impl -> Fiber.return None
-  | Intf -> (
+  | `Other | `Merlin Impl -> Fiber.return None
+  | `Merlin Intf -> (
     let* intf = Inference.infer_intf state doc in
     match intf with
     | None -> Fiber.return None

ocaml-lsp-server/src/document.ml

@@ -111,8 +111,8 @@ let is_merlin = function
   | Merlin _ -> true
 
 let kind = function
-  | Merlin _ as t -> Kind.of_fname (Uri.to_path (uri t))
-  | Other _ -> Code_error.raise "non merlin document has no kind" []
+  | Merlin _ as t -> `Merlin (Kind.of_fname (Uri.to_path (uri t)))
+  | Other _ -> `Other
 
 let syntax = function
   | Merlin m -> m.syntax

ocaml-lsp-server/src/document.mli

@@ -24,7 +24,7 @@ end
 
 val is_merlin : t -> bool
 
-val kind : t -> Kind.t
+val kind : t -> [ `Merlin of Kind.t | `Other ]
 
 val syntax : t -> Syntax.t
 

ocaml-lsp-server/src/inference.ml

@@ -3,11 +3,15 @@ open Fiber.O
 
 let infer_intf_for_impl doc =
   match Document.kind doc with
-  | Intf ->
+  | `Other ->
+    Code_error.raise
+      "expected an implementation document, got a non merlin document"
+      []
+  | `Merlin Intf ->
     Code_error.raise
       "expected an implementation document, got an interface instead"
       []
-  | Impl ->
+  | `Merlin Impl ->
     Document.with_pipeline_exn doc (fun pipeline ->
         let typer = Mpipeline.typer_result pipeline in
         let sig_ : Types.signature =
@@ -59,8 +63,11 @@ let open_document_from_file (state : State.t) uri =
 
 let infer_intf (state : State.t) doc =
   match Document.kind doc with
-  | Impl -> Code_error.raise "the provided document is not an interface." []
-  | Intf ->
+  | `Other ->
+    Code_error.raise "the provided document is not a merlin source." []
+  | `Merlin Impl ->
+    Code_error.raise "the provided document is not an interface." []
+  | `Merlin Intf ->
     Fiber.of_thunk (fun () ->
         let intf_uri = Document.uri doc in
         let impl_uri =

ocaml-lsp-server/src/ocaml_lsp_server.ml

@@ -430,8 +430,8 @@ let text_document_lens (state : State.t)
   let store = state.store in
   let doc = Document_store.get store uri in
   match Document.kind doc with
-  | Intf -> Fiber.return []
-  | Impl ->
+  | `Other | `Merlin Intf -> Fiber.return []
+  | `Merlin Impl ->
     let+ outline =
       let command = Query_protocol.Outline in
       Document.dispatch_exn doc command

ocaml-lsp-server/src/ocamlformat.ml

@@ -132,7 +132,12 @@ let formatter doc =
   match Document.syntax doc with
   | (Dune | Cram | Ocamllex | Menhir) as s -> Error (Unsupported_syntax s)
   | Ocaml -> Ok (Ocaml (Document.uri doc))
-  | Reason -> Ok (Reason (Document.kind doc))
+  | Reason ->
+    Ok
+      (Reason
+         (match Document.kind doc with
+         | `Merlin i -> i
+         | `Other -> Code_error.raise "unable to format non merlin document" []))
 
 let exec cancel bin args stdin =
   let refmt = Fpath.to_string bin in