feature: channel argument support

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

ps-id: c83c8f44-e41d-4e16-9a59-f01ff9654cb9

CHANGES.md

@@ -2,6 +2,9 @@
 
 ## Features
 
+- Support connecting over pipes and socket. Pipes on Windows aren't yet
+  supported (#946)
+
 - Semantic highlighting support is enabled by default (#933)
 
 - Re-enable `ocamlformat-rpc` for formatting code snippets (but not files) (#920, #939)

lsp/src/cli.ml

@@ -0,0 +1,38 @@
+module Channel = struct
+  type t =
+    | Stdio
+    | Pipe of string
+    | Socket of int
+end
+
+module Arg = struct
+  type t =
+    { mutable pipe : string option
+    ; mutable port : int option
+    ; mutable stdio : bool
+    ; mutable spec : (string * Arg.spec * string) list
+    }
+
+  let create () =
+    let t = { pipe = None; port = None; stdio = false; spec = [] } in
+    let spec =
+      [ ("--pipe", Arg.String (fun p -> t.pipe <- Some p), "set pipe path")
+      ; ("--socket", Arg.Int (fun p -> t.port <- Some p), "set port")
+      ; ("--stdio", Arg.Unit (fun () -> t.stdio <- true), "set stdio")
+      ; ( "--node-ipc"
+        , Arg.Unit (fun () -> raise @@ Arg.Bad "node-ipc isn't supported")
+        , "not supported" )
+      ]
+    in
+    t.spec <- spec;
+    t
+
+  let spec t = t.spec
+
+  let read { pipe; port; stdio; spec = _ } : (Channel.t, string) result =
+    match (pipe, port, stdio) with
+    | None, None, _ -> Ok Stdio
+    | Some p, None, false -> Ok (Pipe p)
+    | None, Some s, false -> Ok (Socket s)
+    | _, _, _ -> Error "invalid arguments"
+end

lsp/src/cli.mli

@@ -0,0 +1,16 @@
+module Channel : sig
+  type t =
+    | Stdio
+    | Pipe of string
+    | Socket of int
+end
+
+module Arg : sig
+  type t
+
+  val create : unit -> t
+
+  val spec : t -> (string * Arg.spec * string) list
+
+  val read : t -> (Channel.t, string) result
+end

lsp/src/lsp.ml

@@ -10,3 +10,4 @@ module Text_document = Text_document
 module Types = Types
 module Uri = Uri0
 module Io = Io
+module Cli = Cli

ocaml-lsp-server/bin/dune

@@ -2,4 +2,4 @@
  (name main)
  (package ocaml-lsp-server)
  (public_name ocamllsp)
- (libraries dune-build-info stdune ocaml_lsp_server))
+ (libraries dune-build-info stdune lsp ocaml_lsp_server))

ocaml-lsp-server/bin/main.ml

@@ -1,16 +1,35 @@
+open Stdune
+module Cli = Lsp.Cli
+
 let () =
   Printexc.record_backtrace true;
   let version = ref false in
   let read_dot_merlin = ref false in
-  Arg.parse
+  let arg = Lsp.Cli.Arg.create () in
+  let spec =
     [ ("--version", Arg.Set version, "print version")
     ; ( "--fallback-read-dot-merlin"
       , Arg.Set read_dot_merlin
       , "read Merlin config from .merlin files. The `dot-merlin-reader` \
          package must be installed" )
     ]
-    (fun _ -> raise (Arg.Bad "anonymous arguments are not accepted"))
-    "ocamllsp";
+    @ Cli.Arg.spec arg
+  in
+  let usage =
+    "ocamllsp [ --stdio | --socket SOCKET --port PORT | --pipe PIPE ]"
+  in
+  Arg.parse
+    spec
+    (fun _ -> raise @@ Arg.Bad "anonymous arguments aren't allowed")
+    usage;
+  let channel =
+    match Cli.Arg.read arg with
+    | Ok c -> c
+    | Error s ->
+      Format.eprintf "%s@.%!" s;
+      Arg.usage spec usage;
+      exit 1
+  in
   let version = !version in
   if version then
     let version = Ocaml_lsp_server.Version.get () in
@@ -19,7 +38,7 @@ let () =
     let module Exn_with_backtrace = Stdune.Exn_with_backtrace in
     match
       Exn_with_backtrace.try_with
-        (Ocaml_lsp_server.run ~read_dot_merlin:!read_dot_merlin)
+        (Ocaml_lsp_server.run channel ~read_dot_merlin:!read_dot_merlin)
     with
     | Ok () -> ()
     | Error exn ->

ocaml-lsp-server/src/ocaml_lsp_server.ml

@@ -1010,19 +1010,14 @@ let on_notification server (notification : Client_notification.t) :
     in
     state
 
-let start () =
+let start stream =
   let detached = Fiber.Pool.create () in
   let server = Fdecl.create Dyn.opaque in
   let store = Document_store.make server detached in
   let handler =
     let on_request = { Server.Handler.on_request } in
     Server.Handler.make ~on_request ~on_notification ()
   in
-  let* stream =
-    let* stdin = Lev_fiber.Io.stdin in
-    let+ stdout = Lev_fiber.Io.stdout in
-    Lsp_fiber.Fiber_io.make stdin stdout
-  in
   let ocamlformat_rpc = Ocamlformat_rpc.create () in
   let* configuration = Configuration.default () in
   let wheel = Configuration.wheel configuration in
@@ -1105,8 +1100,37 @@ let start () =
   let metrics = Metrics.create () in
   Metrics.with_metrics metrics run
 
-let run ~read_dot_merlin () =
+let socket sockaddr =
+  let domain = Unix.domain_of_sockaddr sockaddr in
+  let fd =
+    Lev_fiber.Fd.create
+      (Unix.socket ~cloexec:true domain Unix.SOCK_STREAM 0)
+      (`Non_blocking false)
+  in
+  let* () = Lev_fiber.Socket.connect fd sockaddr in
+  Lev_fiber.Io.create_rw fd
+
+let stream_of_channel : Lsp.Cli.Channel.t -> _ = function
+  | Stdio ->
+    let* stdin = Lev_fiber.Io.stdin in
+    let+ stdout = Lev_fiber.Io.stdout in
+    (stdin, stdout)
+  | Pipe path ->
+    if Sys.win32 then (
+      Format.eprintf "windows pipes are not supported";
+      exit 1)
+    else
+      let sockaddr = Unix.ADDR_UNIX path in
+      socket sockaddr
+  | Socket port ->
+    let sockaddr = Unix.ADDR_INET (Unix.inet_addr_loopback, port) in
+    socket sockaddr
+
+let run channel ~read_dot_merlin () =
   Merlin_utils.Lib_config.set_program_name "ocamllsp";
   Merlin_config.should_read_dot_merlin := read_dot_merlin;
   Unix.putenv "__MERLIN_MASTER_PID" (string_of_int (Unix.getpid ()));
-  Lev_fiber.run ~sigpipe:`Ignore start |> Lev_fiber.Error.ok_exn
+  Lev_fiber.run ~sigpipe:`Ignore (fun () ->
+      let* input, output = stream_of_channel channel in
+      start (Lsp_fiber.Fiber_io.make input output))
+  |> Lev_fiber.Error.ok_exn

ocaml-lsp-server/src/ocaml_lsp_server.mli

@@ -1,4 +1,4 @@
-val run : read_dot_merlin:bool -> unit -> unit
+val run : Lsp.Cli.Channel.t -> read_dot_merlin:bool -> unit -> unit
 
 module Diagnostics = Diagnostics
 module Version = Version