Move quoting inside the hook.

Add detailed implementation constraints.

src/ocaml/driver/pparse.ml

@@ -38,34 +38,29 @@ let report_error = function
     log ~title:"report_error"
       "External preprocessor does not produce a valid file. Command line: %s" cmd
 
-
-external windows_merlin_system_command : string -> cwd:string -> int = "ml_merlin_system_command"
-
 let commandline prog args =
-  Printf.sprintf "%s %s" prog (String.concat ~sep:" " args)
-
-let merlin_system_command ~prog ~args ~cwd =
-  let cmd = commandline prog args in
-  if Sys.win32 then
-    windows_merlin_system_command cmd ~cwd
-  else
-    !Std.System_command.unix ~prog ~args ~cwd
+  Filename.quote_command prog args
 
 let apply_rewriter magic ppx (fn_in, failures) =
   let title = "apply_rewriter" in
   let fn_out = Filename.temp_file "camlppx" "" in
-  let args =
-    let redirect =
-      if Sys.win32 then [] else ["1>&2"] in
-    Filename.quote fn_in
-    :: Filename.quote fn_out
-    :: redirect
-  in
+  let args = [fn_in; fn_out] in
   let comm = commandline ppx.workval args in
   log ~title "running %s from directory %S" comm ppx.workdir;
   Logger.log_flush ();
+  let ok =
+    match
+      !System.run_in_directory
+        ~prog:ppx.workval
+        ~prog_is_quoted:true
+        ~args
+        ~cwd:ppx.workdir
+        ()
+    with
+    | `Finished 0 -> true
+    | `Finished _ | `Cancelled -> false
+  in
   let failure =
-    let ok = merlin_system_command ~prog:ppx.workval ~args:args ~cwd:ppx.workdir = 0 in
     if not ok then Some (CannotRun comm)
     else if not (Sys.file_exists fn_out) then
       Some (WrongMagic comm)
@@ -159,12 +154,21 @@ let apply_pp ~workdir ~filename ~source ~pp =
     close_out oc
   end;
   let fn_out = fn_in ^ ".out" in
-  let args = [
-    Filename.quote fn_in;
-    Printf.sprintf "1>%s" (Filename.quote fn_out)
-  ] in
+  let args = [fn_in] in
   let comm = commandline pp args in
-  let ok = merlin_system_command ~prog:pp ~args:args ~cwd:workdir = 0 in
+  let ok =
+    match
+      !System.run_in_directory
+        ~prog:pp
+        ~prog_is_quoted:true
+        ~args
+        ~stdout:fn_out
+        ~cwd:workdir
+        ()
+    with
+    | `Finished 0 -> true
+    | `Finished _ | `Cancelled -> false
+  in
   Misc.remove_file fn_in;
   if not ok then begin
     Misc.remove_file fn_out;

src/utils/lib_config.ml

@@ -9,7 +9,7 @@ module Json = struct
     Std.Json.pretty_to_string := f
 end
 
-module System_command = struct
-  let set_unix f =
-    Std.System_command.unix := f
+module System = struct
+  let set_run_in_directory f =
+    Std.System.run_in_directory := f
 end

src/utils/lib_config.mli

@@ -17,8 +17,39 @@ module Json : sig
 end
 
 (** Merlin spawns child processes for preprocessors (pp and ppx), which can be
-    customized via [System_command] *)
-module System_command : sig
-  (** [set_unix] sets an implementation for Unix systems. *)
-  val set_unix : (prog:string -> args:string list -> cwd:string -> int) -> unit
+    customized via [System] *)
+module System : sig
+  (** [set_run_in_directory] sets an implementation for spawning external
+        programs. This is used by Merlin to spawn preprocessors and ppxes. For
+        compatibility reasons, there are currently some limitations to how this
+        should be implemented:
+
+      - Implementation should expect [prog] to be already quoted and contain
+        arguments. This is due to how ppx configuration is passed to Merlin. In
+        order to prepare a future transition to more sane argument passing, the
+        implementation can look at the [prog_is_quoted] argument to know if it
+        is actually safe to quote the command normally (using
+        [Filename.quote_command] for example).
+
+      - [prog] might contain shell expansions, command substitutions etc. It
+        should therefore be ran under a shell for maximum compatibility. However
+        this should never happen when the configuration is generated by Dune.
+
+      - Programs runned by this function should never output on stdout since it
+        is the channel used by Merlin to communicate with the editor. One way to
+        enforce that is to redirect stdout to stderr.
+
+      - As of today Merlin handles the [`Cancelled] return case identically as
+        other error codes. *)
+  val set_run_in_directory
+    : (prog:string
+    -> prog_is_quoted:bool
+    -> args:string list
+    -> cwd:string
+    -> ?stdin:string
+    -> ?stdout:string
+    -> ?stderr:string
+    -> unit
+    -> [ `Finished of int | `Cancelled ])
+    -> unit
 end

src/utils/std.ml

@@ -751,11 +751,41 @@ module Shell = struct
     List.rev !comps
 end
 
-module System_command = struct
-  let unix = ref @@
-    fun ~prog ~args ~cwd ->
-      let cmd = Printf.sprintf "%s %s" prog (String.concat ~sep:" " args) in
-      Sys.command (Printf.sprintf "cd %s && %s" (Filename.quote cwd) cmd)
+module System = struct
+  external windows_merlin_system_command : string -> cwd:string -> int =
+    "ml_merlin_system_command"
+
+  let run_in_directory
+    : (prog:string
+    -> prog_is_quoted:bool
+    -> args:string list
+    -> cwd:string
+    -> ?stdin:string
+    -> ?stdout:string
+    -> ?stderr:string
+    -> unit
+    -> [ `Finished of int | `Cancelled ]) ref = ref @@
+    fun ~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 args = match stdout with
+        | Some file -> Format.sprintf "%s 1>%s" args (Filename.quote file)
+        | None ->
+          (* Runned program should never output on stdout since it is the
+             channel used by Merlin to communicate with the editor *)
+          if Sys.win32 then args else Format.sprintf "%s 1>&2" args
+      in
+      let cmd = Format.sprintf "%s %s" prog args in
+      let exit_code =
+        if Sys.win32 then
+          (* Note: the following function will never output to stdout *)
+          windows_merlin_system_command cmd ~cwd
+        else
+          Sys.command (Printf.sprintf "cd %s && %s" (Filename.quote cwd) cmd)
+      in
+      `Finished exit_code
 end
 
   (* [modules_in_path ~ext path] lists ocaml modules corresponding to