feature: open related code actions

We can now open documents on the lsp side, which means that we can
implement ml/mli toggling entirely in LSP

ps-id: e8a3b313-bfc9-4f75-af26-48228f3e999a

CHANGES.md

@@ -1,3 +1,9 @@
+# Unreleased
+
+## Features
+
+- Code actions for jumping to related files (`.ml`, `.mli`, etc.) (#795)
+
 # 1.12.4
 
 - Allow cancellation of workspace symbols requests (#777)

ocaml-lsp-server/src/code_actions.ml

@@ -26,8 +26,8 @@ end
 
 let compute server (params : CodeActionParams.t) =
   let state : State.t = Server.state server in
+  let uri = params.textDocument.uri in
   let doc =
-    let uri = params.textDocument.uri in
     let store = state.store in
     Document_store.get_opt store uri
   in
@@ -41,10 +41,11 @@ let compute server (params : CodeActionParams.t) =
   match doc with
   | None -> Fiber.return (Reply.now (actions dune_actions), state)
   | Some doc -> (
+    let open_related = Action_open_related.for_uri uri in
     match Document.syntax doc with
     | Ocamllex | Menhir | Cram | Dune ->
       let state : State.t = Server.state server in
-      Fiber.return (Reply.now (actions dune_actions), state)
+      Fiber.return (Reply.now (actions (dune_actions @ open_related)), state)
     | Ocaml | Reason ->
       let reply () =
         let code_action (ca : Code_action.t) =
@@ -83,8 +84,9 @@ let compute server (params : CodeActionParams.t) =
             ; Action_mark_remove_unused.remove
             ]
         in
-        List.filter_opt code_action_results
-        |> List.append dune_actions |> actions
+        List.concat
+          [ List.filter_opt code_action_results; dune_actions; open_related ]
+        |> actions
       in
       let later f =
         Fiber.return

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

@@ -0,0 +1,48 @@
+open Import
+open Fiber.O
+
+let command_name = "ocamllsp/open-related-source"
+
+let command_run server (params : ExecuteCommandParams.t) =
+  let uri =
+    match params.arguments with
+    | Some [ json ] -> DocumentUri.t_of_yojson json
+    | None | Some _ ->
+      Jsonrpc.Response.Error.raise
+      @@ Jsonrpc.Response.Error.make
+           ~code:Jsonrpc.Response.Error.Code.InvalidParams
+           ~message:"takes a single uri as input" ()
+  in
+  let uri = Uri.to_string uri in
+  let+ { ShowDocumentResult.success } =
+    let req = ShowDocumentParams.create ~uri ~takeFocus:true () in
+    Server.request server (Server_request.ShowDocumentRequest req)
+  in
+  if not success then Format.eprintf "failed to open %s@." uri;
+  `Null
+
+let for_uri uri =
+  Document.get_impl_intf_counterparts uri
+  |> List.map ~f:(fun uri ->
+         let path = Uri.to_path uri in
+         let exists = Sys.file_exists path in
+         let title =
+           sprintf "%s %s"
+             (if exists then "Open" else "Create")
+             (Filename.basename path)
+         in
+         let command =
+           let arguments = [ DocumentUri.yojson_of_t uri ] in
+           Command.create ~title ~command:command_name ~arguments ()
+         in
+         let edit =
+           match exists with
+           | true -> None
+           | false ->
+             let documentChanges =
+               [ `CreateFile (CreateFile.create ~uri ()) ]
+             in
+             Some (WorkspaceEdit.create ~documentChanges ())
+         in
+         CodeAction.create ?edit ~title ~kind:(CodeActionKind.Other "switch")
+           ~command ())

ocaml-lsp-server/src/code_actions/action_open_related.mli

@@ -0,0 +1,7 @@
+open Import
+
+val command_name : string
+
+val command_run : _ Server.t -> ExecuteCommandParams.t -> Json.t Fiber.t
+
+val for_uri : DocumentUri.t -> CodeAction.t list

ocaml-lsp-server/src/import.ml

@@ -149,6 +149,7 @@ include struct
   module CompletionOptions = CompletionOptions
   module CompletionParams = CompletionParams
   module ConfigurationParams = ConfigurationParams
+  module CreateFile = CreateFile
   module Diagnostic = Diagnostic
   module DiagnosticRelatedInformation = DiagnosticRelatedInformation
   module DiagnosticSeverity = DiagnosticSeverity

ocaml-lsp-server/src/ocaml_lsp_server.ml

@@ -83,7 +83,9 @@ let initialize_info : InitializeResult.t =
     in
     let executeCommandProvider =
       ExecuteCommandOptions.create
-        ~commands:(view_metrics_command_name :: Dune.commands)
+        ~commands:
+          (view_metrics_command_name :: Action_open_related.command_name
+         :: Dune.commands)
         ()
     in
     ServerCapabilities.create ~textDocumentSync ~hoverProvider:(`Bool true)
@@ -800,6 +802,10 @@ let on_request :
   | ExecuteCommand command ->
     if String.equal command.command view_metrics_command_name then
       later (fun _state server -> view_metrics server) server
+    else if String.equal command.command Action_open_related.command_name then
+      later
+        (fun _state server -> Action_open_related.command_run server command)
+        server
     else
       later
         (fun state () ->

ocaml-lsp-server/test/e2e-new/code_actions.ml

@@ -50,7 +50,8 @@ let foo = 123
     in
     Fiber.fork_and_join_unit run_client (fun () -> run >>> Client.stop client)
   );
-  [%expect {|
+  [%expect
+    {|
     Code actions:
     {
       "title": "Type-annotate",
@@ -72,4 +73,16 @@ let foo = 123
           }
         ]
       }
+    }
+    {
+      "title": "Create foo.mli",
+      "kind": "switch",
+      "edit": {
+        "documentChanges": [ { "kind": "create", "uri": "file:///foo.mli" } ]
+      },
+      "command": {
+        "title": "Create foo.mli",
+        "command": "ocamllsp/open-related-source",
+        "arguments": [ "file:///foo.mli" ]
+      }
     } |}]

ocaml-lsp-server/test/e2e-new/start_stop.ml

@@ -58,7 +58,10 @@ let%expect_test "start/stop" =
           "renameProvider": { "prepareProvider": true },
           "foldingRangeProvider": true,
           "executeCommandProvider": {
-            "commands": [ "ocamllsp/view-metrics", "dune/promote" ]
+            "commands": [
+              "ocamllsp/view-metrics", "ocamllsp/open-related-source",
+              "dune/promote"
+            ]
           },
           "selectionRangeProvider": true,
           "workspaceSymbolProvider": true,

ocaml-lsp-server/test/e2e/__tests__/textDocument-codeAction.test.ts

@@ -182,6 +182,25 @@ let f (x : t) = x
           "kind": "type-annotate",
           "title": "Type-annotate",
         },
+        Object {
+          "command": Object {
+            "arguments": Array [
+              "file:///test.mli",
+            ],
+            "command": "ocamllsp/open-related-source",
+            "title": "Create test.mli",
+          },
+          "edit": Object {
+            "documentChanges": Array [
+              Object {
+                "kind": "create",
+                "uri": "file:///test.mli",
+              },
+            ],
+          },
+          "kind": "switch",
+          "title": "Create test.mli",
+        },
       ]
     `);
   });
@@ -464,7 +483,29 @@ type x =
     let start = Types.Position.create(2, 5);
     let end = Types.Position.create(2, 6);
     let actions = await codeAction("file:///test.ml", start, end);
-    expect(actions).toBeNull();
+    expect(actions).toMatchInlineSnapshot(`
+      Array [
+        Object {
+          "command": Object {
+            "arguments": Array [
+              "file:///test.mli",
+            ],
+            "command": "ocamllsp/open-related-source",
+            "title": "Create test.mli",
+          },
+          "edit": Object {
+            "documentChanges": Array [
+              Object {
+                "kind": "create",
+                "uri": "file:///test.mli",
+              },
+            ],
+          },
+          "kind": "switch",
+          "title": "Create test.mli",
+        },
+      ]
+    `);
   });
 
   it("offers `Construct an expression` code action", async () => {
@@ -480,7 +521,67 @@ let x = _
       (await codeAction(uri, Position.create(0, 8), Position.create(0, 9))) ??
       [];
 
-    expect(actions).not.toBeNull();
+    expect(actions).toMatchInlineSnapshot(`
+      Array [
+        Object {
+          "edit": Object {
+            "documentChanges": Array [
+              Object {
+                "edits": Array [
+                  Object {
+                    "newText": "(_ : 'a)",
+                    "range": Object {
+                      "end": Object {
+                        "character": 9,
+                        "line": 0,
+                      },
+                      "start": Object {
+                        "character": 8,
+                        "line": 0,
+                      },
+                    },
+                  },
+                ],
+                "textDocument": Object {
+                  "uri": "file:///test.ml",
+                  "version": 0,
+                },
+              },
+            ],
+          },
+          "isPreferred": false,
+          "kind": "type-annotate",
+          "title": "Type-annotate",
+        },
+        Object {
+          "command": Object {
+            "command": "editor.action.triggerSuggest",
+            "title": "Trigger Suggest",
+          },
+          "kind": "construct",
+          "title": "Construct an expression",
+        },
+        Object {
+          "command": Object {
+            "arguments": Array [
+              "file:///test.mli",
+            ],
+            "command": "ocamllsp/open-related-source",
+            "title": "Create test.mli",
+          },
+          "edit": Object {
+            "documentChanges": Array [
+              Object {
+                "kind": "create",
+                "uri": "file:///test.mli",
+              },
+            ],
+          },
+          "kind": "switch",
+          "title": "Create test.mli",
+        },
+      ]
+    `);
 
     let construct_actions = actions.find(
       (codeAction: Types.CodeAction) =>