Add WRAPPING_PREFIX directive

src/dot-merlin/dot_merlin_reader.ml

@@ -102,6 +102,8 @@ module Cache = File_cache.Make (struct
             tell (`SOURCE_ROOT (String.drop 12 line))
           else if String.is_prefixed ~by:"UNIT_NAME " line then
             tell (`UNIT_NAME (String.drop 10 line))
+          else if String.is_prefixed ~by:"WRAPPING_PREFIX " line then
+            tell (`WRAPPING_PREFIX (String.drop 16 line))
           else if String.is_prefixed ~by:"FINDLIB " line then
             tell (`FINDLIB (String.drop 8 line))
           else if String.is_prefixed ~by:"SUFFIX " line then
@@ -317,6 +319,7 @@ type config = {
   stdlib : string option;
   source_root : string option;
   unit_name   : string option;
+  wrapping_prefix : string option;
   packages_to_load : string list;
   findlib : string option;
   findlib_path : string list;
@@ -329,6 +332,7 @@ let empty_config = {
   stdlib            = None;
   source_root       = None;
   unit_name         = None;
+  wrapping_prefix   = None;
   packages_to_load  = [];
   findlib           = None;
   findlib_path      = [];
@@ -358,6 +362,8 @@ let prepend_config ~cwd ~cfg =
       { cfg with source_root = Some canon_path }
     | `UNIT_NAME name ->
       { cfg with unit_name = Some name }
+    | `WRAPPING_PREFIX prefix ->
+      { cfg with wrapping_prefix = Some prefix }
     | `FINDLIB path ->
       let canon_path = canonicalize_filename ~cwd path in
       begin match cfg.stdlib with
@@ -426,6 +432,9 @@ let postprocess cfg =
       )
     ; (cfg.pass_forward :> Merlin_dot_protocol.directive list)
     ; cfg.unit_name |> Option.map ~f:(fun name -> `UNIT_NAME name) |> Option.to_list
+    ; cfg.wrapping_prefix
+        |> Option.map ~f:(fun prefix -> `WRAPPING_PREFIX prefix)
+        |> Option.to_list
     ; List.concat_map pkg_paths ~f:(fun p -> [ `B p; `S p ])
     ; ppx
     ; List.map failures ~f:(fun s -> `ERROR_MSG s)

src/dot-protocol/merlin_dot_protocol.ml

@@ -45,6 +45,7 @@ module Directive = struct
     | `STDLIB of string
     | `SOURCE_ROOT of string
     | `UNIT_NAME of string
+    | `WRAPPING_PREFIX of string
     | `SUFFIX of string
     | `READER of string list
     | `EXCLUDE_QUERY_DIR
@@ -98,6 +99,7 @@ module Sexp = struct
         | "STDLIB" -> `STDLIB value
         | "SOURCE_ROOT" -> `SOURCE_ROOT value
         | "UNIT_NAME" -> `UNIT_NAME value
+        | "WRAPPING_PREFIX" -> `WRAPPING_PREFIX value
         | "SUFFIX" -> `SUFFIX value
         | "ERROR" -> `ERROR_MSG value
         | "FLG" ->
@@ -132,6 +134,7 @@ module Sexp = struct
         | `INDEX s -> ("INDEX", single s)
         | `SOURCE_ROOT s -> ("SOURCE_ROOT", single s)
         | `UNIT_NAME s -> ("UNIT_NAME", single s)
+        | `WRAPPING_PREFIX s -> ("WRAPPING_PREFIX", single s)
         | `EXT ss -> ("EXT", [ List (atoms_of_strings ss) ])
         | `FLG ss -> ("FLG", [ List (atoms_of_strings ss) ])
         | `STDLIB s -> ("STDLIB", single s)

src/dot-protocol/merlin_dot_protocol.mli

@@ -57,6 +57,7 @@ module Directive : sig
     | `STDLIB of string
     | `SOURCE_ROOT of string
     | `UNIT_NAME of string
+    | `WRAPPING_PREFIX of string
     | `SUFFIX of string
     | `READER of string list
     | `EXCLUDE_QUERY_DIR

src/kernel/mconfig.ml

@@ -82,6 +82,7 @@ type merlin = {
   stdlib      : string option;
   source_root : string option;
   unit_name   : string option;
+  wrapping_prefix : string option;
   reader      : string list;
   protocol    : [`Json | `Sexp];
   log_file    : string option;
@@ -125,6 +126,7 @@ let dump_merlin x =
     "stdlib"       , Json.option Json.string x.stdlib;
     "source_root"  , Json.option Json.string x.source_root;
     "unit_name"    , Json.option Json.string x.unit_name;
+    "wrapping_prefix" , Json.option Json.string x.wrapping_prefix;
     "reader"       , `List (List.map ~f:Json.string x.reader);
     "protocol"     , (match x.protocol with
         | `Json -> `String "json"
@@ -260,6 +262,10 @@ let merge_merlin_config dot merlin ~failures ~config_path =
       (if dot.source_root = None then merlin.source_root else dot.source_root);
     unit_name =
       (if dot.unit_name = None then merlin.unit_name else dot.unit_name);
+    wrapping_prefix =
+      if dot.wrapping_prefix = None
+      then merlin.wrapping_prefix
+      else dot.wrapping_prefix;
     reader =
       if dot.reader = []
       then merlin.reader
@@ -662,6 +668,7 @@ let initial = {
     stdlib      = None;
     source_root = None;
     unit_name   = None;
+    wrapping_prefix = None;
     reader      = [];
     protocol    = `Json;
     log_file    = None;
@@ -842,4 +849,9 @@ let filename t = t.query.filename
 let unitname t =
   match t.merlin.unit_name with
   | Some name -> Misc.unitname name
-  | None -> Misc.unitname t.query.filename
+  | None ->
+    let basename = Misc.unitname t.query.filename in
+    begin match t.merlin.wrapping_prefix with
+    | Some prefix -> prefix ^ basename
+    | None -> basename
+    end

src/kernel/mconfig.mli

@@ -40,6 +40,7 @@ type merlin = {
   stdlib      : string option;
   source_root : string option;
   unit_name   : string option;
+  wrapping_prefix : string option;
   reader      : string list;
   protocol    : [`Json | `Sexp];
   log_file    : string option;

src/kernel/mconfig_dot.ml

@@ -46,6 +46,7 @@ type config = {
   stdlib       : string option;
   source_root  : string option;
   unit_name    : string option;
+  wrapping_prefix : string option;
   reader       : string list;
   exclude_query_dir : bool;
   use_ppx_cache : bool;
@@ -65,6 +66,7 @@ let empty_config = {
   stdlib       = None;
   source_root  = None;
   unit_name    = None;
+  wrapping_prefix = None;
   reader       = [];
   exclude_query_dir = false;
   use_ppx_cache = false;
@@ -264,6 +266,8 @@ let prepend_config ~dir:cwd configurator (directives : directive list) config =
       {config with source_root = Some path}, errors
     | `UNIT_NAME name ->
       {config with unit_name = Some name}, errors
+    | `WRAPPING_PREFIX prefix ->
+      {config with wrapping_prefix = Some prefix}, errors
     | `READER reader ->
       {config with reader}, errors
     | `EXCLUDE_QUERY_DIR ->
@@ -297,6 +301,7 @@ let postprocess_config config =
     stdlib      = config.stdlib;
     source_root = config.source_root;
     unit_name   = config.unit_name;
+    wrapping_prefix = config.wrapping_prefix;
     reader      = config.reader;
     exclude_query_dir = config.exclude_query_dir;
     use_ppx_cache = config.use_ppx_cache;

src/kernel/mconfig_dot.mli

@@ -48,6 +48,7 @@ type config = {
   stdlib       : string option;
   source_root  : string option;
   unit_name    : string option;
+  wrapping_prefix : string option;
   reader       : string list;
   exclude_query_dir : bool;
   use_ppx_cache : bool;

tests/test-dirs/config/dot-merlin-reader/load-config.t

@@ -44,6 +44,7 @@ This test comes from: https://github.com/janestreet/merlin-jst/pull/59
     "stdlib": null,
     "source_root": null,
     "unit_name": null,
+    "wrapping_prefix": null,
     "reader": [],
     "protocol": "json",
     "log_file": null,

tests/test-dirs/config/dot-merlin-reader/quoting.t

@@ -56,6 +56,7 @@
     "stdlib": null,
     "source_root": null,
     "unit_name": null,
+    "wrapping_prefix": null,
     "reader": [],
     "protocol": "json",
     "log_file": null,