[B] #1811 Exposes some helper for reducing direct typedtree usage in Lsp

src/analysis/misc_utils.ml

@@ -58,13 +58,13 @@ let parenthesize_name name =
       "(" ^ 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
+let parse_identifier (config, source) pos =
+  let path = Mreader.reconstruct_identifier config source pos in
+  let path = Mreader_lexer.identifier_suffix path in
+  Logger.log
+    ~section:Type_enclosing.log_section
+    ~title:"reconstruct-identifier"
+    "paths: [%s]"
+    (String.concat ~sep:";" (List.map path
+      ~f:(fun l -> l.Location.txt)));
+  path

src/analysis/misc_utils.mli

@@ -23,11 +23,7 @@ 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
+(** [parse_identifier] attempts to re-parse a longident so that we get
+    the location of each of its components. *)
+val parse_identifier :
+  (Mconfig.t * Msource.t) -> Lexing.position -> string Location.loc list

src/analysis/type_utils.ml

@@ -370,3 +370,4 @@ let is_deprecated =
            ("deprecated" | "ocaml.deprecated"); loc = _}, _ ->
         true
       | _ -> false)
+

src/analysis/typedtree_utils.ml

@@ -0,0 +1,51 @@
+open Std
+
+let extract_toplevel_identifier item =
+  match item.Typedtree.sig_desc with
+  | Typedtree.Tsig_value { val_id; _ } ->  [val_id]
+  | Typedtree.Tsig_modsubst { ms_id; _ } -> [ms_id]
+  | Typedtree.Tsig_modtype { mtd_id; _ }
+  | Typedtree.Tsig_modtypesubst { mtd_id; _ } ->  [mtd_id]
+  | Typedtree.Tsig_module { md_id; _ } -> Option.to_list md_id
+  | Typedtree.Tsig_recmodule mods ->
+      List.filter_map ~f:(fun Typedtree.{md_id; _} -> md_id) mods
+  | Typedtree.Tsig_class cls ->
+      List.map ~f:(fun Typedtree.{ ci_id_class; _} -> ci_id_class) cls
+  | Typedtree.Tsig_class_type cls ->
+    List.map
+      ~f:(fun Typedtree.{ ci_id_class_type; _} -> ci_id_class_type)
+      cls
+  | Typedtree.Tsig_type _
+  | Typedtree.Tsig_typesubst _
+  | Typedtree.Tsig_typext _
+  | Typedtree.Tsig_exception _
+  | Typedtree.Tsig_open _
+  | Typedtree.Tsig_include _
+  | Typedtree.Tsig_attribute _ -> []
+
+let let_bound_vars bindings =
+  List.filter_map ~f:(fun value_binding ->
+    match value_binding.Typedtree.vb_pat.pat_desc with
+    | Tpat_var (id, loc) -> Some (id, loc)
+    | Typedtree.Tpat_any
+    | Typedtree.Tpat_alias (_, _, _)
+    | Typedtree.Tpat_constant _
+    | Typedtree.Tpat_tuple _
+    | Typedtree.Tpat_construct (_, _, _, _)
+    | Typedtree.Tpat_variant (_, _, _)
+    | Typedtree.Tpat_record (_, _)
+    | Typedtree.Tpat_array _
+    | Typedtree.Tpat_lazy _
+    | Typedtree.Tpat_or (_, _, _) -> None
+  ) bindings
+
+let pat_var_id_and_loc = function
+  | Typedtree.{ pat_desc = Tpat_var (id, loc); _ } ->
+    Some (id, loc)
+  | _ -> None
+
+let pat_alias_pat_id_and_loc = function
+  | Typedtree.{ pat_desc = Tpat_alias (pat, id, loc); _ } ->
+    Some (pat, id, loc)
+  | _ -> None
+

src/analysis/typedtree_utils.mli

@@ -0,0 +1,23 @@
+(** Utilities to keep explicit Typedtree manipulations local to Merlin_lib
+    for alternative clients like [ocaml-lsp]. *)
+
+(** [extract_toplevel_identifier sigitem] extracts toplevel identifier of
+    a signature item. It returns a list for dealing with recursive elements. *)
+val extract_toplevel_identifier : Typedtree.signature_item -> Ident.t list
+
+(** [let_bound_vars binding_list] extract the [Ident.t] and the
+    location of variables bind in the form of [let b = e ...] in a
+    list of bindings. *)
+val let_bound_vars :
+  Typedtree.value_binding list -> (Ident.t * string Location.loc) list
+
+(** [pat_var_id_and_loc] try to extract the [id] and the [location] of
+    pattern variable. *)
+val pat_var_id_and_loc :
+  Typedtree.pattern -> (Ident.t * string Location.loc) option
+
+(** [pat_alias_id_and_loc] try to extract the [id] and the [location]
+    of pattern alias. *)
+val pat_alias_pat_id_and_loc
+  : Typedtree.pattern
+  -> (Typedtree.pattern * Ident.t * string Location.loc) option