Add attribute to mark whether an identifier is generated by ppx_template

Author: liam923

src/analysis/completion.ml

@@ -244,10 +244,17 @@ let make_candidate ~get_doc ~attrs ~exact ~prefix_path name ?loc ?path ty =
       | _, _ -> `None)
   in
   let deprecated = Type_utils.is_deprecated attrs in
-  { name; kind; desc; info; deprecated }
+  let ppx_template_generated = Type_utils.is_ppx_template_generated attrs in
+  { name; kind; desc; info; deprecated; ppx_template_generated }
 
 let item_for_global_module name =
-  { name; kind = `Module; desc = `None; info = `None; deprecated = false }
+  { name;
+    kind = `Module;
+    desc = `None;
+    info = `None;
+    deprecated = false;
+    ppx_template_generated = false
+  }
 
 let fold_variant_constructors ~env ~init ~f =
   let rec aux acc t =
@@ -537,7 +544,8 @@ let complete_methods ~env ~prefix obj =
         kind = `MethodCall;
         desc = `Type_scheme ty;
         info;
-        deprecated = false
+        deprecated = false;
+        ppx_template_generated = false
       })
 
 type is_label =
@@ -639,7 +647,8 @@ let complete_prefix ?get_doc ?target_type ?(kinds = []) ~keywords ~prefix
                   kind = `Keyword;
                   desc = `None;
                   info = `None;
-                  deprecated = false
+                  deprecated = false;
+                  ppx_template_generated = false
                 }
                 :: candidates
               else candidates)
@@ -654,7 +663,8 @@ let complete_prefix ?get_doc ?target_type ?(kinds = []) ~keywords ~prefix
                 kind = `Module;
                 desc = `None;
                 info = `None;
-                deprecated = false
+                deprecated = false;
+                ppx_template_generated = false
               }
             in
             if name = prefix && uniq (`Mod, name) then

src/analysis/type_utils.ml

@@ -377,3 +377,9 @@ let is_deprecated =
       match Ast_helper.Attr.as_tuple attr with
       | { Location.txt = "deprecated" | "ocaml.deprecated"; loc = _ }, _ -> true
       | _ -> false)
+
+let is_ppx_template_generated =
+  List.exists ~f:(fun (attr : Parsetree.attribute) ->
+      match Ast_helper.Attr.as_tuple attr with
+      | { Location.txt = "merlin.ppx_template_generated"; loc = _ }, _ -> true
+      | _ -> false)

src/analysis/type_utils.mli

@@ -83,6 +83,8 @@ val read_doc_attributes : Parsetree.attributes -> (string * Location.t) option
 
 val is_deprecated : Parsetree.attributes -> bool
 
+val is_ppx_template_generated : Parsetree.attributes -> bool
+
 val print_constr :
   verbosity:Mconfig.Verbosity.t ->
   Env.t ->

src/commands/query_json.ml

@@ -304,14 +304,18 @@ let json_of_error (error : Location.error) =
   in
   with_location ~skip_none:true loc content
 
-let json_of_completion { Compl.name; kind; desc; info; deprecated } =
+let json_of_completion
+    { Compl.name; kind; desc; info; deprecated; ppx_template_generated } =
   `Assoc
-    [ ("name", `String name);
-      ("kind", `String (string_of_completion_kind kind));
-      ("desc", `String desc);
-      ("info", `String info);
-      ("deprecated", `Bool deprecated)
-    ]
+    ([ ("name", `String name);
+       ("kind", `String (string_of_completion_kind kind));
+       ("desc", `String desc);
+       ("info", `String info);
+       ("deprecated", `Bool deprecated)
+     ]
+    @
+    if ppx_template_generated then [ ("ppx_template_generated", `Bool true) ]
+    else [])
 
 let json_of_completions { Compl.entries; context } =
   `Assoc

src/frontend/query_commands.ml

@@ -491,7 +491,13 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = function
              let name = Format.flush_str_formatter () in
              Printtyp.type_scheme env Format.str_formatter v.Types.val_type;
              let desc = Format.flush_str_formatter () in
-             { Compl.name; kind = `Value; desc; info = ""; deprecated = false })
+             { Compl.name;
+               kind = `Value;
+               desc;
+               info = "";
+               deprecated = false;
+               ppx_template_generated = false
+             })
     in
     { Compl.entries; context = `Unknown }
   | Type_search (query, pos, limit, with_doc) ->

src/frontend/query_protocol.ml

@@ -41,7 +41,9 @@ module Compl = struct
         | `Keyword ];
       desc : 'desc;
       info : 'desc;
-      deprecated : bool
+      deprecated : bool;
+      ppx_template_generated : bool
+          (** [true] if the identifier was generated by ppx_template *)
     }
 
   type entry = string raw_entry

tests/test-dirs/completion/ppx-template-generated.t/bar.ml

@@ -0,0 +1,18 @@
+module Module = struct end
+
+module Module_gen = struct end [@@merlin.ppx_template_generated]
+
+let value = ()
+let value_gen = () [@@merlin.ppx_template_generated]
+
+let func () = ()
+let func_gen () = () [@@merlin.ppx_template_generated]
+
+type t_abstract
+type t_abstract_gen [@@merlin.ppx_template_generated]
+
+type t_concrete = int
+type t_concrete_gen = int [@@merlin.ppx_template_generated]
+
+module Foo = Foo
+module Foo_gen = Foo

tests/test-dirs/completion/ppx-template-generated.t/baz.ml

@@ -0,0 +1,15 @@
+module Module = struct end
+
+module Module_gen = struct end
+
+let value = ()
+let value_gen = ()
+
+let func () = ()
+let func_gen () = ()
+
+type t_abstract
+type t_abstract_gen
+
+type t_concrete = int
+type t_concrete_gen = int

tests/test-dirs/completion/ppx-template-generated.t/baz.mli

@@ -0,0 +1 @@
+include Baz_intf.S

tests/test-dirs/completion/ppx-template-generated.t/baz_intf.ml

@@ -0,0 +1,17 @@
+module type S = sig
+  module Module : sig end
+
+  module Module_gen : sig end [@@merlin.ppx_template_generated]
+
+  val value : unit
+  val value_gen : unit [@@merlin.ppx_template_generated]
+
+  val func : unit -> unit
+  val func_gen : unit -> unit [@@merlin.ppx_template_generated]
+
+  type t_abstract
+  type t_abstract_gen [@@merlin.ppx_template_generated]
+
+  type t_concrete = int
+  type t_concrete_gen = int [@@merlin.ppx_template_generated]
+end