feature: Use Merlin as a libray (#1070)

This adds support for the ppx_cache directive

.github/workflows/build-and-test.yml

@@ -47,9 +47,19 @@ jobs:
 
       - name: Use OCaml ${{ matrix.ocaml-compiler }}
         uses: ocaml/setup-ocaml@v2
+        if: matrix.os != 'windows-latest'
         with:
           ocaml-compiler: ${{ matrix.ocaml-compiler }}
 
+      - name: Use OCaml ${{ matrix.ocaml-compiler }} (Win)
+        uses: ocaml/setup-ocaml@v2
+        if: matrix.os == 'windows-latest'
+        with:
+          ocaml-compiler: ${{ matrix.ocaml-compiler }}
+          opam-repositories: |
+            opam-repository-mingw: https://github.com/ocaml-opam/opam-repository-mingw.git#sunset
+            default: https://github.com/ocaml/opam-repository.git
+
       - name: Install opam packages
         run: opam install .
 
@@ -88,12 +98,12 @@ jobs:
         run: |
           git config --global user.name github-actions[bot]
           git config --global user.email github-actions[bot]@users.noreply.github.com
-    
+
       - name: Install deps on Unix
         run: |
           opam install . --deps-only
           opam exec -- make coverage-deps install-test-deps
       - run: opam exec -- make test-coverage
         env:
           COVERALLS_REPO_TOKEN: ${{ secrets.GITHUB_TOKEN }}
-          PULL_REQUEST_NUMBER: ${{ github.event.number }}
+          PULL_REQUEST_NUMBER: ${{ github.event.number }}

CHANGES.md

@@ -49,6 +49,7 @@
 
 - Add "Remove type annotation" code action. (#1039)
 - Support settings through `didChangeConfiguration` notification (#1103)
+- Depend directly on `merlin-lib` 4.9 (#1070)
 
 # 1.15.1
 

dune-project

@@ -65,7 +65,8 @@ possible and does not make any assumptions about IO.
   (csexp (>= 1.5))
   (ocamlformat-rpc-lib (>= 0.21.0))
   (odoc :with-doc)
-  (ocaml (and (>= 4.14) (< 4.15)))))
+  ocaml
+  (merlin-lib (and (>= 4.9) (< 5.0)))))
 
 (package
  (name jsonrpc)

flake.nix

@@ -102,6 +102,7 @@
               uutf
               lsp
               odoc-parser
+              merlin-lib
             ];
             doCheck = false;
           };
@@ -171,6 +172,7 @@
                 ppx_yojson_conv_lib
                 uutf
                 lsp
+                merlin-lib
               ];
               propagatedBuildInputs = [ ];
               doCheck = false;

jsonrpc.opam

@@ -26,7 +26,6 @@ depends: [
 dev-repo: "git+https://github.com/ocaml/ocaml-lsp.git"
 build: [
   ["dune" "subst"] {dev}
-  ["ocaml" "unix.cma" "unvendor.ml"]
   [
     "dune"
     "build"

lsp.opam

@@ -36,7 +36,6 @@ depends: [
 dev-repo: "git+https://github.com/ocaml/ocaml-lsp.git"
 build: [
   ["dune" "subst"] {dev}
-  ["ocaml" "unix.cma" "unvendor.ml"]
   [
     "dune"
     "build"

lsp.opam.template

@@ -1,6 +1,5 @@
 build: [
   ["dune" "subst"] {dev}
-  ["ocaml" "unix.cma" "unvendor.ml"]
   [
     "dune"
     "build"

ocaml-lsp-server.opam

@@ -41,7 +41,8 @@ depends: [
   "csexp" {>= "1.5"}
   "ocamlformat-rpc-lib" {>= "0.21.0"}
   "odoc" {with-doc}
-  "ocaml" {>= "4.14" & < "4.15"}
+  "ocaml"
+  "merlin-lib" {>= "4.9" & < "5.0"}
 ]
 dev-repo: "git+https://github.com/ocaml/ocaml-lsp.git"
 build: [

ocaml-lsp-server/src/merlin_config.ml

@@ -59,6 +59,7 @@ module Config = struct
     ; stdlib : string option
     ; reader : string list
     ; exclude_query_dir : bool
+    ; use_ppx_cache : bool
     }
 
   let empty =
@@ -72,6 +73,7 @@ module Config = struct
     ; stdlib = None
     ; reader = []
     ; exclude_query_dir = false
+    ; use_ppx_cache = false
     }
 
   (* Parses suffixes pairs that were supplied as whitespace separated pairs
@@ -110,6 +112,7 @@ module Config = struct
       | `STDLIB path -> ({ config with stdlib = Some path }, errors)
       | `READER reader -> ({ config with reader }, errors)
       | `EXCLUDE_QUERY_DIR -> ({ config with exclude_query_dir = true }, errors)
+      | `USE_PPX_CACHE -> ({ config with use_ppx_cache = true }, errors)
       | `UNKNOWN_TAG _ ->
         (* For easier forward compatibility we ignore unknown configuration tags
            when they are provided by dune *)
@@ -129,6 +132,7 @@ module Config = struct
       ; stdlib = config.stdlib
       ; reader = config.reader
       ; exclude_query_dir = config.exclude_query_dir
+      ; use_ppx_cache = config.use_ppx_cache
       }
 
   let merge t (merlin : Mconfig.merlin) failures config_path =
@@ -223,6 +227,17 @@ module Dot_protocol_io =
     (struct
       include Lev_fiber_csexp.Session
 
+      type in_chan = t
+
+      type out_chan = t
+
+      let read t =
+        let open Fiber.O in
+        let+ opt = read t in
+        match opt with
+        | Some r -> Result.return r
+        | None -> Error "Read error"
+
       let write t x = write t [ x ]
     end)
 

ocaml-lsp-server/src/ocaml_lsp_server.ml

@@ -438,7 +438,7 @@ let references (state : State.t)
   | `Other -> Fiber.return None
   | `Merlin doc ->
     let command =
-      Query_protocol.Occurrences (`Ident_at (Position.logical position))
+      Query_protocol.Occurrences (`Ident_at (Position.logical position), `Buffer)
     in
     let+ locs = Document.Merlin.dispatch_exn doc command in
     Some
@@ -455,7 +455,7 @@ let highlight (state : State.t)
   | `Other -> Fiber.return None
   | `Merlin m ->
     let command =
-      Query_protocol.Occurrences (`Ident_at (Position.logical position))
+      Query_protocol.Occurrences (`Ident_at (Position.logical position), `Buffer)
     in
     let+ locs = Document.Merlin.dispatch_exn m command in
     let lsp_locs =
@@ -630,7 +630,8 @@ let on_request :
         | `Other -> Fiber.return None
         | `Merlin doc ->
           let command =
-            Query_protocol.Occurrences (`Ident_at (Position.logical position))
+            Query_protocol.Occurrences
+              (`Ident_at (Position.logical position), `Buffer)
           in
           let+ locs = Document.Merlin.dispatch_exn doc command in
           let loc =
@@ -860,8 +861,65 @@ let stream_of_channel : Lsp.Cli.Channel.t -> _ = function
     let sockaddr = Unix.ADDR_INET (Unix.inet_addr_loopback, port) in
     socket sockaddr
 
+(* Merlin uses [Sys.command] to run preprocessors and ppxes. We provide an
+   alternative version using the Spawn library for unixes.
+
+   TODO: Currently PPX config is passed to Merlin in the form of a quoted shell
+   command. The [prog_is_quoted] argument in Merlin's API is meant to allow
+   supporting a way to launch ppx executables without using the shell.
+
+   This will require additionnal changes of the API so there is no need to deal
+   with the [prog_is_quoted] argument until this happen. *)
+let run_in_directory ~prog ~prog_is_quoted:_ ~args ~cwd ?stdin ?stdout ?stderr
+    () =
+  (* Currently we assume that [prog] is always quoted and might contain
+     arguments such as [-as-ppx]. This is due to the way Merlin gets its
+     configuration. Thus we cannot rely on [Filename.quote_command]. *)
+  let args = String.concat ~sep:" " @@ List.map ~f:Filename.quote args in
+  let cmd = Format.sprintf "%s %s" prog args in
+
+  let prog = "/bin/sh" in
+  let argv = [ "sh"; "-c"; cmd ] in
+  let stdin =
+    match stdin with
+    | Some file -> Unix.openfile file [ Unix.O_WRONLY ] 0x664
+    | None -> Unix.openfile "/dev/null" [ Unix.O_RDONLY ] 0x777
+  in
+  let stdout, should_close_stdout =
+    match stdout with
+    | Some file -> (Unix.openfile file [ Unix.O_WRONLY ] 0x664, true)
+    | None ->
+      (* Runned programs should never output to stdout since it is the channel
+         used by LSP to communicate with the editor *)
+      (Unix.stderr, false)
+  in
+  let stderr =
+    Option.map stderr ~f:(fun file ->
+        Unix.openfile file [ Unix.O_WRONLY ] 0x664)
+  in
+  let pid =
+    let cwd : Spawn.Working_dir.t = Path cwd in
+    Spawn.spawn ~cwd ~prog ~argv ~stdin ~stdout ?stderr ()
+  in
+  let _, status = Unix.waitpid [] pid in
+  let res =
+    match (status : Unix.process_status) with
+    | WEXITED n -> n
+    | WSIGNALED _ -> -1
+    | WSTOPPED _ -> -1
+  in
+  Unix.close stdin;
+  if should_close_stdout then Unix.close stdout;
+  `Finished res
+
+let run_in_directory =
+  (* Merlin has specific stubs for Windows, we reuse them *)
+  let for_windows = !Merlin_utils.Std.System.run_in_directory in
+  fun () -> if Sys.win32 then for_windows else run_in_directory
+
 let run channel ~read_dot_merlin () =
   Merlin_utils.Lib_config.set_program_name "ocamllsp";
+  Merlin_utils.Lib_config.System.set_run_in_directory (run_in_directory ());
   Merlin_config.should_read_dot_merlin := read_dot_merlin;
   Unix.putenv "__MERLIN_MASTER_PID" (string_of_int (Unix.getpid ()));
   Lev_fiber.run ~sigpipe:`Ignore (fun () ->

ocaml-lsp-server/src/rename.ml

@@ -8,7 +8,7 @@ let rename (state : State.t)
   | `Other -> Fiber.return (WorkspaceEdit.create ())
   | `Merlin merlin ->
     let command =
-      Query_protocol.Occurrences (`Ident_at (Position.logical position))
+      Query_protocol.Occurrences (`Ident_at (Position.logical position), `Buffer)
     in
     let+ locs = Document.Merlin.dispatch_exn merlin command in
     let version = Document.version doc in

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

@@ -109,6 +109,8 @@ describe("textDocument/hover", () => {
           \`\`\`ocaml
           'a -> 'a
           \`\`\`
+          ---
+          This function has a nice documentation
           `,
       },
     });