Allow to set up merlin in a variant of the default context (ocaml#4145)

* Add test
* Test with parsing failure on mutltiple merlin contexts
* Allow to set up merlin in a variant of the default context.
* Add changelog entry

Signed-off-by: Ulysse Gérard <thevoodoos@gmail.com>
Co-authored-by: Lucas Pluvinage <lucas@tarides.com>

Author: voodoos

CHANGES.md

@@ -1,3 +1,9 @@
+2.9.0 (unreleased)
+------------------
+
+- Allow to set up merlin in a variant of the default context
+  (#4145, @TheLortex, @voodoos)
+
 2.8.5 (28/03/2021)
 ------------------
 

src/dune_rules/context.ml

@@ -743,6 +743,7 @@ let instantiate_context env (workspace : Workspace.t)
       ; fdo_target_exe
       ; dynamically_linked_foreign_archives
       ; instrument_with
+      ; merlin = _
       } ->
     let merlin =
       workspace.merlin_context = Some (Workspace.Context.name context)
@@ -772,10 +773,10 @@ let instantiate_context env (workspace : Workspace.t)
           ; fdo_target_exe
           ; dynamically_linked_foreign_archives
           ; instrument_with
+          ; merlin
           }
       ; switch
       ; root
-      ; merlin
       } ->
     let env = extend_paths ~env paths in
     create_for_opam ~root ~env_nodes ~env ~profile ~switch ~name ~merlin

src/dune_rules/workspace.ml

@@ -51,6 +51,7 @@ module Context = struct
       ; fdo_target_exe : Path.t option
       ; dynamically_linked_foreign_archives : bool
       ; instrument_with : Lib_name.t list
+      ; merlin : bool
       }
 
     let to_dyn = Dyn.Encoder.opaque
@@ -67,6 +68,7 @@ module Context = struct
         ; fdo_target_exe
         ; dynamically_linked_foreign_archives
         ; instrument_with
+        ; merlin
         } t =
       Profile.equal profile t.profile
       && List.equal Target.equal targets t.targets
@@ -81,6 +83,7 @@ module Context = struct
       && Bool.equal dynamically_linked_foreign_archives
            t.dynamically_linked_foreign_archives
       && List.equal Lib_name.equal instrument_with t.instrument_with
+      && Bool.equal merlin t.merlin
 
     let fdo_suffix t =
       match t.fdo_target_exe with
@@ -140,7 +143,8 @@ module Context = struct
       and+ instrument_with =
         field ~default:instrument_with "instrument_with"
           (Dune_lang.Syntax.since syntax (2, 7) >>> repeat Lib_name.decode)
-      and+ loc = loc in
+      and+ loc = loc
+      and+ merlin = field_b "merlin" in
       Option.iter host_context ~f:(fun _ ->
           match targets with
           | [ Target.Native ] -> ()
@@ -161,6 +165,7 @@ module Context = struct
       ; fdo_target_exe
       ; dynamically_linked_foreign_archives
       ; instrument_with
+      ; merlin
       }
   end
 
@@ -169,29 +174,25 @@ module Context = struct
       { base : Common.t
       ; switch : string
       ; root : string option
-      ; merlin : bool
       }
 
-    let to_dyn { base; switch; root; merlin } =
+    let to_dyn { base; switch; root } =
       let open Dyn.Encoder in
       record
         [ ("base", Common.to_dyn base)
         ; ("switch", string switch)
         ; ("root", option string root)
-        ; ("merlin", bool merlin)
         ]
 
-    let equal { base; switch; root; merlin } t =
+    let equal { base; switch; root } t =
       Common.equal base t.base
       && String.equal switch t.switch
       && Option.equal String.equal root t.root
-      && Bool.equal merlin t.merlin
 
     let t ~profile ~instrument_with ~x =
       let+ loc_switch, switch = field "switch" (located string)
       and+ name = field_o "name" Context_name.decode
       and+ root = field_o "root" string
-      and+ merlin = field_b "merlin"
       and+ base = Common.t ~profile ~instrument_with in
       let name =
         match name with
@@ -209,7 +210,7 @@ module Context = struct
               ])
       in
       let base = { base with targets = Target.add base.targets x; name } in
-      { base; switch; root; merlin }
+      { base; switch; root }
   end
 
   module Default = struct
@@ -306,6 +307,7 @@ module Context = struct
       ; fdo_target_exe = None
       ; dynamically_linked_foreign_archives = true
       ; instrument_with = Option.value instrument_with ~default:[]
+      ; merlin = false
       }
 end
 
@@ -418,10 +420,13 @@ let t ?x ?profile:cmdline_profile ?instrument_with:cmdline_instrument_with () =
           Context_name.Set.union !defined_names
             (Context_name.Set.of_list (Context.all_names ctx));
         match (ctx, acc) with
-        | Opam { merlin = true; _ }, Some _ ->
+        | Opam { base = { merlin = true; _ }; _ }, Some _
+        | Default { merlin = true; _ }, Some _ ->
           User_error.raise ~loc:(Context.loc ctx)
             [ Pp.text "you can only have one context for merlin" ]
-        | Opam { merlin = true; _ }, None -> Some name
+        | Opam { base = { merlin = true; _ }; _ }, None
+        | Default { merlin = true; _ }, None ->
+          Some name
         | _ -> acc)
   in
   let contexts =

src/dune_rules/workspace.mli

@@ -30,6 +30,7 @@ module Context : sig
                 the runtime system. *)
       ; dynamically_linked_foreign_archives : bool
       ; instrument_with : Lib_name.t list
+      ; merlin : bool
       }
   end
 
@@ -40,7 +41,6 @@ module Context : sig
                 is left opaque as we leave to opam to interpret it. *)
       ; switch : string
       ; root : string option
-      ; merlin : bool
       }
   end
 

test/blackbox-tests/test-cases/merlin/default-based-context.t/dune

@@ -0,0 +1,2 @@
+(library
+ (name foo))

test/blackbox-tests/test-cases/merlin/default-based-context.t/dune-project

@@ -0,0 +1 @@
+(lang dune 2.9)

test/blackbox-tests/test-cases/merlin/default-based-context.t/foo.ml

@@ -0,0 +1,2 @@
+let bar = 42
+let r = Result.Ok "3"

test/blackbox-tests/test-cases/merlin/default-based-context.t/run.t

@@ -0,0 +1,75 @@
+  $ export BUILD_PATH_PREFIX_MAP=\
+  > "OPAM_PREFIX=$(opam config var prefix):$BUILD_PATH_PREFIX_MAP"
+
+If Merlin field is absent, default context is chosen
+
+  $ cat >dune-workspace <<EOF
+  > (lang dune 2.9)
+  > (context (default))
+  > (context
+  >  (default
+  >   (name cross)))
+  > EOF
+
+  $ dune build
+
+  $ [ ! -d _build/cross/.merlin-conf ] && echo "No config in cross"
+  No config in cross
+
+  $ ls -a _build/default/.merlin-conf
+  .
+  ..
+  lib-foo
+
+  $ dune ocaml-merlin --dump-config="$(pwd)"
+  Foo
+  ((STDLIB OPAM_PREFIX/lib/ocaml)
+   (EXCLUDE_QUERY_DIR)
+   (B
+    $TESTCASE_ROOT/_build/default/.foo.objs/byte)
+   (S
+    $TESTCASE_ROOT)
+   (FLG
+    (-w
+     @1..3@5..28@30..39@43@46..47@49..57@61..62-40
+     -strict-sequence
+     -strict-formats
+     -short-paths
+     -keep-locs)))
+
+If Merlin field is present, this context is chosen
+
+  $ cat >dune-workspace <<EOF
+  > (lang dune 2.8)
+  > (context (default))
+  > (context
+  >  (default
+  >   (name cross)
+  >   (merlin)))
+  > EOF
+
+  $ dune build
+
+  $ ls -a _build/cross/.merlin-conf
+  .
+  ..
+  lib-foo
+
+  $ [ ! -d _build/default/.merlin-conf ] && echo "No config in default"
+  No config in default
+
+  $ dune ocaml-merlin --dump-config="$(pwd)"
+  Foo
+  ((STDLIB OPAM_PREFIX/lib/ocaml)
+   (EXCLUDE_QUERY_DIR)
+   (B
+    $TESTCASE_ROOT/_build/cross/.foo.objs/byte)
+   (S
+    $TESTCASE_ROOT)
+   (FLG
+    (-w
+     @1..3@5..28@30..39@43@46..47@49..57@61..62-40
+     -strict-sequence
+     -strict-formats
+     -short-paths
+     -keep-locs)))

test/blackbox-tests/test-cases/workspaces.t/multiple-merlin-contexts/dune-workspace

@@ -0,0 +1,12 @@
+(lang dune 1.0)
+
+(context
+ (default
+  (merlin)))
+
+(context
+ (opam
+  (switch foo-switch)
+  (name foo-name)
+  (profile foo-profile)
+  (merlin)))

test/blackbox-tests/test-cases/workspaces.t/run.t

@@ -50,3 +50,14 @@ Workspaces also allow you to set the env for a context:
   (c_flags ())
   (cxx_flags ())
   (menhir_flags ())
+
+  $ dune build --root multiple-merlin-contexts 
+  Entering directory 'multiple-merlin-contexts'
+  File "dune-workspace", line 8, characters 1-82:
+   8 |  (opam
+   9 |   (switch foo-switch)
+  10 |   (name foo-name)
+  11 |   (profile foo-profile)
+  12 |   (merlin)))
+  Error: you can only have one context for merlin
+  [1]