Compat: expose some utilities for ocaml-lsp backward compatibility (o…

…caml#1730)

from voodoos/lib-expose-config

CHANGES.md

@@ -10,6 +10,8 @@ merlin NEXT_VERSION
     - Add a query_num field to the `ocamlmerlin` responses to detect server crashes (#1716)
     - Jump to cases within a match statement (#1726)
     - Jump to `module-type` (#1728, partially fixes #1656)
+    - Exposes stable functions for configuration handling and pattern variable
+      destruction. (#1730)
   + editor modes
     - vim: load merlin under the ocamlinterface and ocamllex filetypes (#1340)
     - Fix merlinpp not using binary file open (#1725, fixes #1724)

src/analysis/misc_utils.ml

@@ -57,3 +57,14 @@ let parenthesize_name name =
     else
       "(" ^ name ^ ")"
   )
+
+module Compat = struct
+  open Typedtree
+  let pat_var_id_and_loc = function
+    | { pat_desc = Tpat_var (id, loc); _ } -> Some (id, loc)
+    | _ -> None
+
+  let pat_alias_pat_id_and_loc = function
+    | { pat_desc = Tpat_alias (pat, id, loc); _ } -> Some (pat, id, loc)
+    | _ -> None
+end

src/analysis/misc_utils.mli

@@ -22,3 +22,12 @@ end
 
 (* Add parenthesis to qualified operators *)
 val parenthesize_name : string -> string
+
+module Compat : sig
+  val pat_var_id_and_loc :
+    Typedtree.pattern -> (Ident.t * string Location.loc) option
+
+  val pat_alias_pat_id_and_loc
+    : Typedtree.pattern
+    -> (Typedtree.pattern * Ident.t * string Location.loc) option
+end

src/kernel/mconfig.ml

@@ -232,33 +232,34 @@ let rec normalize t =
   ) else
     normalize (normalize_step t)
 
+let merge_merlin_config dot merlin ~failures ~config_path =
+  { merlin with
+    build_path = dot.Mconfig_dot.build_path @ merlin.build_path;
+    source_path = dot.source_path @ merlin.source_path;
+    cmi_path = dot.cmi_path @ merlin.cmi_path;
+    cmt_path = dot.cmt_path @ merlin.cmt_path;
+    exclude_query_dir = dot.exclude_query_dir || merlin.exclude_query_dir;
+    use_ppx_cache = dot.use_ppx_cache || merlin.use_ppx_cache;
+    extensions = dot.extensions @ merlin.extensions;
+    suffixes = dot.suffixes @ merlin.suffixes;
+    stdlib = (if dot.stdlib = None then merlin.stdlib else dot.stdlib);
+    reader =
+      if dot.reader = []
+      then merlin.reader
+      else dot.reader;
+    flags_to_apply = dot.flags @ merlin.flags_to_apply;
+    failures = failures @ merlin.failures;
+    config_path = Some config_path;
+  }
+
 let get_external_config path t =
   let path = Misc.canonicalize_filename path in
   let directory = Filename.dirname path in
   match Mconfig_dot.find_project_context directory with
   | None -> t
   | Some (ctxt, config_path) ->
     let dot, failures = Mconfig_dot.get_config ctxt path in
-    let merlin = t.merlin in
-    let merlin = {
-      merlin with
-      build_path = dot.build_path @ merlin.build_path;
-      source_path = dot.source_path @ merlin.source_path;
-      cmi_path = dot.cmi_path @ merlin.cmi_path;
-      cmt_path = dot.cmt_path @ merlin.cmt_path;
-      exclude_query_dir = dot.exclude_query_dir || merlin.exclude_query_dir;
-      use_ppx_cache = dot.use_ppx_cache || merlin.use_ppx_cache;
-      extensions = dot.extensions @ merlin.extensions;
-      suffixes = dot.suffixes @ merlin.suffixes;
-      stdlib = (if dot.stdlib = None then merlin.stdlib else dot.stdlib);
-      reader =
-        if dot.reader = []
-        then merlin.reader
-        else dot.reader;
-      flags_to_apply = dot.flags @ merlin.flags_to_apply;
-      failures = failures @ merlin.failures;
-      config_path = Some config_path;
-    } in
+    let merlin = merge_merlin_config dot t.merlin ~failures ~config_path in
     normalize { t with merlin }
 
 let merlin_flags = [

src/kernel/mconfig.mli

@@ -89,6 +89,10 @@ val initial : t
 
 val dump : t -> json
 
+val merge_merlin_config :
+  Mconfig_dot.config
+  -> merlin -> failures:(string list) -> config_path:string -> merlin
+
 val get_external_config : string -> t -> t
 
 val normalize : t -> t

src/kernel/mconfig_dot.mli

@@ -28,6 +28,12 @@
 
 open Std
 
+module Configurator : sig
+  type t =
+    | Dot_merlin
+    | Dune
+end
+
 type config = {
   build_path   : string list;
   source_path  : string list;
@@ -42,6 +48,23 @@ type config = {
   use_ppx_cache : bool;
 }
 
+val empty_config : config
+
+(** [prepend_config ~dir c directives config] parses [directives] and update
+    [config] accordingly, prepending new items when to already existing list
+    fields of [config]. [dir] is used as the [workdir] for flags declared in the
+    [directives]. If [c = Dune], unknown directives are ignored. *)
+val prepend_config
+  : dir:string
+  -> Configurator.t
+  -> Merlin_dot_protocol.directive list
+  -> config
+  -> config * string list
+
+(** [prostprocess_config config] removes duplicates and reverses the lists in
+    [config] *)
+val postprocess_config : config -> config
+
 type context
 
 val get_config : context -> string -> config * string list