Add new UNIT_NAME configuration directive

CHANGES.md

@@ -9,6 +9,8 @@ UNRELEASED
           indexes.
         - `INDEX` that is used to declare the list of index files Merlin should
           use when looking for occurrences.
+    - A new `UNIT_NAME` configuration directive that can be used to tell Merlin
+      the correct name of the current unit in the presence of wrapping (#1776)
   + editor modes
     - emacs: add basic support for project-wide occurrences (#1766)
 

src/dot-merlin/dot_merlin_reader.ml

@@ -100,6 +100,8 @@ module Cache = File_cache.Make (struct
             tell (`STDLIB (String.drop 7 line))
           else if String.is_prefixed ~by:"SOURCE_ROOT " line then
             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:"FINDLIB " line then
             tell (`FINDLIB (String.drop 8 line))
           else if String.is_prefixed ~by:"SUFFIX " line then
@@ -314,6 +316,7 @@ type config = {
   to_canonicalize : (string * Merlin_dot_protocol.Directive.include_path) list;
   stdlib : string option;
   source_root : string option;
+  unit_name   : string option;
   packages_to_load : string list;
   findlib : string option;
   findlib_path : string list;
@@ -325,6 +328,7 @@ let empty_config = {
   to_canonicalize   = [];
   stdlib            = None;
   source_root       = None;
+  unit_name         = None;
   packages_to_load  = [];
   findlib           = None;
   findlib_path      = [];
@@ -352,6 +356,8 @@ let prepend_config ~cwd ~cfg =
     | `SOURCE_ROOT path ->
       let canon_path = canonicalize_filename ~cwd path in
       { cfg with source_root = Some canon_path }
+    | `UNIT_NAME name ->
+      { cfg with unit_name = Some name }
     | `FINDLIB path ->
       let canon_path = canonicalize_filename ~cwd path in
       begin match cfg.stdlib with

src/dot-protocol/merlin_dot_protocol.ml

@@ -44,6 +44,7 @@ module Directive = struct
     | `FLG of string list
     | `STDLIB of string
     | `SOURCE_ROOT of string
+    | `UNIT_NAME of string
     | `SUFFIX of string
     | `READER of string list
     | `EXCLUDE_QUERY_DIR
@@ -96,6 +97,7 @@ module Sexp = struct
         | "INDEX" -> `INDEX value
         | "STDLIB" -> `STDLIB value
         | "SOURCE_ROOT" -> `SOURCE_ROOT value
+        | "UNIT_NAME" -> `UNIT_NAME value
         | "SUFFIX" -> `SUFFIX value
         | "ERROR" -> `ERROR_MSG value
         | "FLG" ->
@@ -129,6 +131,7 @@ module Sexp = struct
         | `CMT s -> ("CMT", single s)
         | `INDEX s -> ("INDEX", single s)
         | `SOURCE_ROOT s -> ("SOURCE_ROOT", single s)
+        | `UNIT_NAME s -> ("UNIT_NAME", 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

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

src/kernel/mconfig.ml

@@ -81,6 +81,7 @@ type merlin = {
   suffixes    : (string * string) list;
   stdlib      : string option;
   source_root : string option;
+  unit_name   : string option;
   reader      : string list;
   protocol    : [`Json | `Sexp];
   log_file    : string option;
@@ -123,6 +124,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;
     "reader"       , `List (List.map ~f:Json.string x.reader);
     "protocol"     , (match x.protocol with
         | `Json -> `String "json"
@@ -256,6 +258,8 @@ let merge_merlin_config dot merlin ~failures ~config_path =
     stdlib = (if dot.stdlib = None then merlin.stdlib else dot.stdlib);
     source_root =
       (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);
     reader =
       if dot.reader = []
       then merlin.reader
@@ -657,6 +661,7 @@ let initial = {
     suffixes    = [(".ml", ".mli"); (".re", ".rei")];
     stdlib      = None;
     source_root = None;
+    unit_name   = None;
     reader      = [];
     protocol    = `Json;
     log_file    = None;
@@ -834,4 +839,7 @@ let global_modules ?(include_current=false) config = (
 
 let filename t = t.query.filename
 
-let unitname t = Misc.unitname t.query.filename
+let unitname t =
+  match t.merlin.unit_name with
+  | Some name -> Misc.unitname name
+  | None -> Misc.unitname t.query.filename

src/kernel/mconfig.mli

@@ -39,6 +39,7 @@ type merlin = {
   suffixes    : (string * string) list;
   stdlib      : string option;
   source_root : string option;
+  unit_name   : string option;
   reader      : string list;
   protocol    : [`Json | `Sexp];
   log_file    : string option;

src/kernel/mconfig_dot.ml

@@ -45,6 +45,7 @@ type config = {
   suffixes     : (string * string) list;
   stdlib       : string option;
   source_root  : string option;
+  unit_name    : string option;
   reader       : string list;
   exclude_query_dir : bool;
   use_ppx_cache : bool;
@@ -63,6 +64,7 @@ let empty_config = {
   flags        = [];
   stdlib       = None;
   source_root  = None;
+  unit_name    = None;
   reader       = [];
   exclude_query_dir = false;
   use_ppx_cache = false;
@@ -260,6 +262,8 @@ let prepend_config ~dir:cwd configurator (directives : directive list) config =
       {config with stdlib = Some path}, errors
     | `SOURCE_ROOT path ->
       {config with source_root = Some path}, errors
+    | `UNIT_NAME name ->
+      {config with unit_name = Some name}, errors
     | `READER reader ->
       {config with reader}, errors
     | `EXCLUDE_QUERY_DIR ->
@@ -292,6 +296,7 @@ let postprocess_config config =
     flags        = clean config.flags;
     stdlib      = config.stdlib;
     source_root = config.source_root;
+    unit_name   = config.unit_name;
     reader      = config.reader;
     exclude_query_dir = config.exclude_query_dir;
     use_ppx_cache = config.use_ppx_cache;

src/kernel/mconfig_dot.mli

@@ -47,6 +47,7 @@ type config = {
   suffixes     : (string * string) list;
   stdlib       : string option;
   source_root  : string option;
+  unit_name    : string option;
   reader       : string list;
   exclude_query_dir : bool;
   use_ppx_cache : bool;

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

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

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

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