Disable merlin-specific quoting

Signed-off-by: Ulysse Gérard <[email protected]>

src/dune/merlin.ml

@@ -54,27 +54,13 @@ module Pp = struct
         pp
 end
 
-let quote_for_merlin s =
-  let s =
-    if Sys.win32 then
-      (* We need this hack because merlin unescapes backslashes (except when
-         protected by single quotes). It is only a problem on windows because
-         Filename.quote is using double quotes. *)
-      String.escape_only '\\' s
-    else
-      s
-  in
-  if String.need_quoting s then
-    Filename.quote s
-  else
-    s
-
 module Dot_file = struct
   let to_string ~obj_dirs ~src_dirs ~flags ~pp =
     let serialize_path = Path.to_absolute_filename in
-    let make_directive tag value = Sexp.List [ Atom tag; Atom value ] in
+    let to_atom s = Sexp.Atom s in
+    let make_directive tag value = Sexp.List [ Atom tag; value ] in
     let make_directive_of_path tag path =
-      make_directive tag (serialize_path path)
+      make_directive tag (Sexp.Atom (serialize_path path))
     in
     let exclude_query_dir = [ Sexp.List [ Atom "EXCLUDE_QUERY_DIR" ] ] in
     let obj_dirs =
@@ -88,12 +74,11 @@ module Dot_file = struct
         match flags with
         | [] -> []
         | flags ->
-          [ make_directive "FLG"
-              (String.concat ~sep:" " (List.map ~f:quote_for_merlin flags))
-          ]
+          [ make_directive "FLG" (Sexp.List (List.map ~f:to_atom flags)) ]
       in
       match pp with
-      | Some pp_flags -> make_directive "FLG" pp_flags :: flags
+      | Some (pp_flag, pp_args) ->
+        make_directive "FLG" (Sexp.List [ Atom pp_flag; Atom pp_args ]) :: flags
       | None -> flags
     in
     Csexp.to_string
@@ -142,8 +127,14 @@ let merlin_file_name = ".merlin-conf"
 let add_source_dir t dir =
   { t with source_dirs = Path.Source.Set.add t.source_dirs dir }
 
+let quote_if_needed s =
+  if String.need_quoting s then
+    Filename.quote s
+  else
+    s
+
 let pp_flag_of_action ~expander ~loc ~action :
-    string option Build.With_targets.t =
+    (string * string) option Build.With_targets.t =
   match (action : Action_dune_lang.t) with
   | Run (exe, args) -> (
     let args =
@@ -171,10 +162,12 @@ let pp_flag_of_action ~expander ~loc ~action :
         match exe with
         | Error _ -> None
         | Ok exe ->
-          Path.to_absolute_filename exe :: args
-          |> List.map ~f:quote_for_merlin
-          |> String.concat ~sep:" " |> Filename.quote |> sprintf "-pp %s"
-          |> Option.some
+          let args =
+            Path.to_absolute_filename exe :: args
+            |> List.map ~f:quote_if_needed
+            |> String.concat ~sep:" "
+          in
+          Some ("-pp", args)
       in
       Build.With_targets.map action ~f:(function
         | Run (exe, args) -> pp_of_action exe args
@@ -184,7 +177,7 @@ let pp_flag_of_action ~expander ~loc ~action :
   | _ -> Build.With_targets.return None
 
 let pp_flags sctx ~expander { preprocess; libname; _ } :
-    string option Build.With_targets.t =
+    (string * string) option Build.With_targets.t =
   let scope = Expander.scope expander in
   match
     Preprocess.remove_future_syntax preprocess ~for_:Merlin
@@ -197,10 +190,12 @@ let pp_flags sctx ~expander { preprocess; libname; _ } :
     with
     | Error _exn -> Build.With_targets.return None
     | Ok (exe, flags) ->
-      Path.to_absolute_filename (Path.build exe) :: "--as-ppx" :: flags
-      |> List.map ~f:quote_for_merlin
-      |> String.concat ~sep:" " |> Filename.quote |> sprintf "-ppx %s"
-      |> Option.some |> Build.With_targets.return )
+      let args =
+        Path.to_absolute_filename (Path.build exe) :: "--as-ppx" :: flags
+        |> List.map ~f:quote_if_needed
+        |> String.concat ~sep:" "
+      in
+      Build.With_targets.return (Some ("-ppx", args)) )
   | Action (loc, (action : Action_dune_lang.t)) ->
     pp_flag_of_action ~expander ~loc ~action
   | No_preprocessing -> Build.With_targets.return None