test(single-context): generate mode-aware Merlin configs

Signed-off-by: Antonio Nuno Monteiro <anmonteiro@gmail.com>

Author: anmonteiro

src/dune_rules/gen_rules.ml

@@ -60,12 +60,11 @@ end = struct
     ; source_dirs : 'source_dirs
     }
 
-  let empty_none = { merlin = None; cctx = None; js = None; source_dirs = None }
+  let empty_none = { merlin = []; cctx = []; js = None; source_dirs = None }
   let empty_list = { merlin = []; cctx = Loc.Map.empty; js = []; source_dirs = [] }
 
-  let add_map_maybe hd_o tl =
-    match hd_o with
-    | Some (loc, hd) ->
+  let add_map hds tl =
+    List.fold_left hds ~init:tl ~f:(fun tl (loc, hd) ->
       Loc.Map.update tl loc ~f:(function
         | None ->
           Some
@@ -78,20 +77,16 @@ end = struct
             (Compilation_mode.By_mode.of_list
                ~init:None
                ((Compilation_context.for_ hd, Some hd)
-                :: List.map current ~f:(fun (k, v) -> k, Some v))))
-    | None -> tl
-  ;;
-
-  let cons_maybe hd_o tl =
-    match hd_o with
-    | Some hd -> hd :: tl
-    | None -> tl
+                :: List.map current ~f:(fun (k, v) -> k, Some v)))))
   ;;
 
   let cons acc x =
-    { merlin = cons_maybe x.merlin acc.merlin
-    ; cctx = add_map_maybe x.cctx acc.cctx
-    ; source_dirs = cons_maybe x.source_dirs acc.source_dirs
+    { merlin = List.rev_append x.merlin acc.merlin
+    ; cctx = add_map x.cctx acc.cctx
+    ; source_dirs =
+        (match x.source_dirs with
+         | None -> acc.source_dirs
+         | Some source_dir -> source_dir :: acc.source_dirs)
     ; js =
         (match x.js with
          | None -> acc.js
@@ -107,7 +102,7 @@ end = struct
   ;;
 
   let with_cctx_merlin ~loc (cctx, merlin) =
-    { empty_none with merlin = Some merlin; cctx = Some (loc, cctx) }
+    { empty_none with merlin = [ merlin ]; cctx = [ loc, cctx ] }
   ;;
 
   let if_available_buildable ~loc f = function
@@ -129,12 +124,16 @@ end = struct
           (Scope.libs scope)
           (Local (Library.to_lib_id ~src_dir lib))
       in
-      if_available_buildable
-        ~loc:lib.buildable.loc
+      if_available
         (fun () ->
-           Lib_rules.rules lib ~sctx ~scope ~dir_contents ~expander
-           >>| Compilation_mode.By_mode.choose
-           >>| Option.value_exn)
+           let+ cctx_merlins = Lib_rules.rules lib ~sctx ~scope ~dir_contents ~expander in
+           let cctx_merlins =
+             Compilation_mode.By_mode.to_list cctx_merlins |> List.map ~f:snd
+           in
+           { empty_none with
+             merlin = List.map cctx_merlins ~f:snd
+           ; cctx = List.map cctx_merlins ~f:(fun (cctx, _) -> lib.buildable.loc, cctx)
+           })
         enabled_if
     | Foreign_library.T lib ->
       Expander.eval_blang expander lib.enabled_if

src/dune_rules/lib_rules.ml

@@ -551,6 +551,7 @@ let library_rules
       ~compile_info
       ~ctx_dir
       ~for_merlin
+      ~merlin_ident
   =
   let modules = Compilation_context.modules cctx in
   let obj_dir = Compilation_context.obj_dir cctx in
@@ -640,18 +641,22 @@ let library_rules
     let+ requires_hidden = Compilation_context.requires_hidden cctx
     and+ parameters = Compilation_context.parameters cctx in
     let flags = Compilation_context.flags cctx in
+    let preprocess =
+      match for_ with
+      | Ocaml -> lib.buildable.preprocess.config
+      | Melange -> lib.buildable.melange_preprocess.config
+    in
     Merlin.make
       ~requires_compile
       ~requires_hidden
       ~stdlib_dir:lib_config.stdlib_dir
       ~flags
       ~modules
-      ~preprocess:
-        (Preprocess.Per_module.without_instrumentation lib.buildable.preprocess.config)
+      ~preprocess:(Preprocess.Per_module.without_instrumentation preprocess)
       ~libname:(Some (snd lib.name))
       ~obj_dir
       ~dialects:(Dune_project.dialects (Scope.project scope))
-      ~ident:(Merlin_ident.for_lib (Library.best_name lib))
+      ~ident:merlin_ident
       ~for_
       ~parameters
   in
@@ -701,7 +706,7 @@ let compile_context (lib : Library.t) ~sctx ~dir_contents ~expander ~scope ~for_
 let rules (lib : Library.t) ~sctx ~dir_contents ~expander ~scope =
   let dir = Dir_contents.dir dir_contents in
   let buildable = lib.buildable in
-  let f ~for_ ~for_merlin =
+  let f ~for_ ~for_merlin ~merlin_ident =
     let* local_lib, compile_info, source_modules, parameters =
       compile_context_data lib ~dir_contents ~scope ~for_
     in
@@ -735,6 +740,7 @@ let rules (lib : Library.t) ~sctx ~dir_contents ~expander ~scope =
         ~compile_info
         ~ctx_dir:dir
         ~for_merlin
+        ~merlin_ident
     in
     cctx, merlin
   in
@@ -751,10 +757,14 @@ let rules (lib : Library.t) ~sctx ~dir_contents ~expander ~scope =
         ~dir
         ~lib_config
     in
-    let merlin_ident = Merlin_ident.for_lib (Library.best_name lib) in
     let { Compilation_mode.for_merlin; modes } =
       Compilation_mode.of_mode_set (Lib_info.modes lib_info)
     in
+    let mode_suffix =
+      match modes with
+      | _ :: _ :: _ -> true
+      | [] | [ _ ] -> false
+    in
     Memo.parallel_map modes ~f:(fun for_ ->
       let buildable = lib.buildable in
       let libs = Scope.libs scope in
@@ -769,14 +779,17 @@ let rules (lib : Library.t) ~sctx ~dir_contents ~expander ~scope =
           ~allow_overlaps:buildable.allow_overlapping_dependencies
       in
       let* () = Buildable_rules.gen_select_rules sctx compile_info ~dir ~for_ in
+      let merlin_ident =
+        Merlin_ident.for_lib (Library.best_name lib) ~for_ ~mode_suffix
+      in
       let+ r =
         Buildable_rules.with_lib_deps
           (Super_context.context sctx)
           merlin_ident
           ~dir
           ~f:(fun () ->
             let for_merlin = Compilation_mode.equal for_ for_merlin in
-            f ~for_ ~for_merlin)
+            f ~for_ ~for_merlin ~merlin_ident)
       in
       for_, Some r)
   in

src/dune_rules/merlin/merlin_ident.ml

@@ -1,18 +1,23 @@
 open Import
 
 type t =
-  | Lib of Lib_name.t
+  | Lib of Lib_name.t * [ `Mode_suffix of Compilation_mode.t | `No_suffix ]
   | Exes of string Nonempty_list.t
   | Melange_entries of string
 
-let for_lib l = Lib l
+let for_lib l ~for_ ~mode_suffix =
+  Lib (l, if mode_suffix then `Mode_suffix for_ else `No_suffix)
+;;
+
 let for_exes ~names = Exes names
 let for_melange ~target = Melange_entries target
 
 (* For debug purposes we use the name of one library or executable and the hash
    of the others if there are multiple executables to name the merlin file *)
 let to_string = function
-  | Lib name -> sprintf "lib-%s" (Lib_name.to_string name)
+  | Lib (name, (`No_suffix | `Mode_suffix Ocaml)) ->
+    sprintf "lib-%s" (Lib_name.to_string name)
+  | Lib (name, `Mode_suffix Melange) -> sprintf "lib-%s-melange" (Lib_name.to_string name)
   | Exes [ name ] -> sprintf "exe-%s" name
   | Exes (name :: names) ->
     sprintf "exe-%s-%s" name Digest.(repr (Repr.list String.repr) names |> to_string)

src/dune_rules/merlin/merlin_ident.mli

@@ -4,7 +4,7 @@ open Import
     to a specific [library] or [executable] stanza. *)
 type t
 
-val for_lib : Lib_name.t -> t
+val for_lib : Lib_name.t -> for_:Compilation_mode.t -> mode_suffix:bool -> t
 val for_exes : names:string Nonempty_list.t -> t
 val for_melange : target:string -> t
 

test/blackbox-tests/test-cases/melange/merlin.t

@@ -496,3 +496,99 @@ User ppx flags should appear in merlin config
       ]
     ]
   }
+
+Mixed OCaml/Melange libraries generate separate Merlin configuration files.
+
+  $ mkdir mixed
+  $ cat > mixed/dune-project <<EOF
+  > (lang dune 3.24)
+  > (using melange 0.1)
+  > EOF
+  $ cat > mixed/pp_ocaml.sh <<'EOF'
+  > #!/bin/sh
+  > cat "$1"
+  > EOF
+  $ cat > mixed/pp_melange.sh <<'EOF'
+  > #!/bin/sh
+  > cat "$1"
+  > EOF
+  $ chmod +x mixed/pp_ocaml.sh mixed/pp_melange.sh
+  $ cat > mixed/dune <<EOF
+  > (library
+  >  (name mixed)
+  >  (modules foo)
+  >  (modes :standard melange)
+  >  (preprocess
+  >   (action
+  >    (run sh %{dep:pp_ocaml.sh} %{input-file})))
+  >  (melange.preprocess
+  >   (action
+  >    (run sh %{dep:pp_melange.sh} %{input-file}))))
+  > EOF
+  $ cat > mixed/foo.ml <<EOF
+  > let x = "foo"
+  > EOF
+
+  $ dune build --root mixed @check
+  $ find mixed/_build/default/.merlin-conf -type f | sort
+  mixed/_build/default/.merlin-conf/lib-mixed
+  mixed/_build/default/.merlin-conf/lib-mixed-melange
+
+The old `File` query still returns the default OCaml Merlin configuration.
+
+  $ query_ocaml_merlin_pp "$PWD/mixed/foo.ml" --root mixed | grep -E 'STDLIB|\(B .*\.mixed\.objs'
+   (STDLIB /OCAMLC_WHERE)
+   (B $TESTCASE_ROOT/mixed/_build/default/.mixed.objs/byte)
+  $ query_ocaml_merlin_pp "$PWD/mixed/foo.ml" --root mixed | grep -E 'MELC_STDLIB|\.objs/melange|pp_melange'
+  [1]
+
+Both generated configurations remain available to debug tooling.
+
+  $ dune ocaml merlin dump-config --root mixed --format=json "$PWD/mixed" | jq '
+  > include "dune";
+  > def local_path:
+  >   gsub("^.*test/blackbox-tests/test-cases/melange/merlin/mixed"; "$TESTCASE_ROOT/mixed")
+  >   | sub("^.*_build/default/"; "_build/default/");
+  > def mode:
+  >   if
+  >     [ .config[] | select(.[0] == "B") | .[1] ]
+  >     | any(contains(".objs/melange"))
+  >   then "melange" else "ocaml" end;
+  > [
+  >   .[]
+  >   | select(.module_name == "Foo")
+  >   | {
+  >       mode: mode,
+  >       obj_dir:
+  >         [ .config[]
+  >         | select(.[0] == "B")
+  >         | .[1]
+  >         | select(contains("_build/default"))
+  >         | local_path
+  >         ][0],
+  >       preprocess:
+  >         [ .config[]
+  >         | select(.[0] == "FLG")
+  >         | .[1]
+  >         | select(.[0] == "-pp")
+  >         | .[1]
+  >         | if contains("pp_melange") then "melange" else "ocaml" end
+  >         ]
+  >         | unique
+  >         | .[0]
+  >     }
+  > ]
+  > | unique_by(.mode)
+  > | sort_by(if .mode == "ocaml" then 0 else 1 end)' | censor
+  [
+    {
+      "mode": "ocaml",
+      "obj_dir": "_build/default/.mixed.objs/byte",
+      "preprocess": "ocaml"
+    },
+    {
+      "mode": "melange",
+      "obj_dir": "_build/default/.mixed.objs/melange",
+      "preprocess": "melange"
+    }
+  ]