[display] list @:deprecated meta in display/completion responses (#8207)

* return "pos" for "meta" in json

* added optional "params.meta" field for json display requests

* move request details out of jsonrpc_handler

* [completion] do not add `meta:[]` to response json if meta was not requested

src/compiler/displayOutput.ml

@@ -799,6 +799,6 @@ let handle_syntax_completion com kind p =
 			Buffer.add_string b "</il>";
 			let s = Buffer.contents b in
 			raise (Completion s)
-		| Some(f,_) ->
-			let ctx = Genjson.create_context GMFull in
+		| Some(f,_,jsonrpc) ->
+			let ctx = Genjson.create_context ~jsonrpc:jsonrpc GMFull in
 			f(fields_to_json ctx l kind None)

src/compiler/main.ml

@@ -1013,8 +1013,8 @@ with
 		begin
 			DisplayPosition.display_position#reset;
 			match ctx.com.json_out with
-			| Some (f,_) ->
-				let ctx = DisplayJson.create_json_context (match de with DisplayFields _ -> true | _ -> false) in
+			| Some (f,_,jsonrpc) ->
+				let ctx = DisplayJson.create_json_context jsonrpc (match de with DisplayFields _ -> true | _ -> false) in
 				f (DisplayException.to_json ctx de)
 			| _ -> assert false
 		end
@@ -1088,8 +1088,8 @@ with
 		| None -> ()
 		| Some fields ->
 			begin match ctx.com.json_out with
-			| Some (f,_) ->
-				let ctx = DisplayJson.create_json_context false in
+			| Some (f,_,jsonrpc) ->
+				let ctx = DisplayJson.create_json_context jsonrpc false in
 				let path = match List.rev p with
 					| name :: pack -> List.rev pack,name
 					| [] -> [],""

src/compiler/server.ml

@@ -49,7 +49,7 @@ let check_display_flush ctx f_otherwise = match ctx.com.json_out with
 		| _ ->
 			f_otherwise ()
 		end
-	| Some(_,f) ->
+	| Some(_,f,_) ->
 		if ctx.has_error then begin
 			let errors = List.map (fun msg ->
 				let msg,p,i = match msg with

src/context/common.ml

@@ -208,7 +208,7 @@ type context = {
 	net_path_map : (path,string list * string list * string) Hashtbl.t;
 	mutable c_args : string list;
 	mutable js_gen : (unit -> unit) option;
-	mutable json_out : ((Json.t -> unit) * (Json.t list -> unit)) option;
+	mutable json_out : ((Json.t -> unit) * (Json.t list -> unit) * Jsonrpc_handler.jsonrpc_handler) option;
 	(* typing *)
 	mutable basic : basic_types;
 	memory_marker : float array;

src/context/display/displayJson.ml

@@ -35,8 +35,8 @@ let json_of_times root =
 
 let supports_resolve = ref false
 
-let create_json_context may_resolve =
-	Genjson.create_context (if may_resolve && !supports_resolve then GMMinimum else GMFull)
+let create_json_context jsonrpc may_resolve =
+	Genjson.create_context ~jsonrpc:jsonrpc (if may_resolve && !supports_resolve then GMMinimum else GMFull)
 
 let send_string j =
 	raise (DisplayOutput.Completion j)
@@ -264,7 +264,7 @@ let parse_input com input report_times =
 		send_json (JsonRpc.error jsonrpc#get_id 0 ~data:(Some (JArray jl)) "Compiler error")
 	in
 
-	com.json_out <- Some(send_result,send_error);
+	com.json_out <- Some(send_result,send_error,jsonrpc);
 
 	let cs = match CompilationServer.get() with
 		| Some cs -> cs

src/core/display/completionItem.ml

@@ -237,7 +237,9 @@ module CompletionModuleType = struct
 				("isFinal",jbool cm.is_final) ::
 				(if ctx.generation_mode = GMFull then ["doc",jopt jstring cm.doc] else [])
 			| GMMinimum ->
-				[("meta",generate_minimum_metadata ctx cm.meta)]
+				match generate_minimum_metadata ctx cm.meta with
+					| None -> []
+					| Some meta -> [("meta",meta)]
 			)
 		in
 		jobject fields

src/core/json/genjson.ml

@@ -11,6 +11,7 @@ type generation_mode =
 type context = {
 	generation_mode : generation_mode;
 	generate_abstract_impl : bool;
+	request : JsonRequest.json_request option
 }
 
 let jnull = Json.JNull
@@ -149,6 +150,7 @@ and generate_metadata_entry ctx (m,el,p) =
 	jobject [
 		"name",jstring (Meta.to_string m);
 		"params",jlist (generate_expr ctx) el;
+		"pos",generate_pos ctx p;
 	]
 
 and generate_metadata ctx ml =
@@ -159,10 +161,18 @@ and generate_metadata ctx ml =
 	jlist (generate_metadata_entry ctx) ml
 
 and generate_minimum_metadata ctx ml =
-	let ml = List.filter (fun (m,_,_) ->
-		m = Meta.Deprecated
-	) ml in
-	jlist (generate_metadata_entry ctx) ml
+	match ctx.request with
+		| None -> None
+		| Some request ->
+			match request#get_requested_meta_list with
+				| None -> None
+				| Some requested ->
+					let ml =
+						List.filter
+							(fun (m,_,_) -> List.exists (fun r -> r = to_string m) requested)
+							ml
+					in
+					Some (jlist (generate_metadata_entry ctx) ml)
 
 (* AST.ml structures *)
 
@@ -677,9 +687,10 @@ let generate_module ctx m =
 		]) :: acc) m.m_extra.m_deps []);
 	]
 
-let create_context gm = {
+let create_context ?jsonrpc gm = {
 	generation_mode = gm;
 	generate_abstract_impl = false;
+	request = match jsonrpc with None -> None | Some jsonrpc -> Some (new JsonRequest.json_request jsonrpc)
 }
 
 let generate types file =

src/core/json/jsonRequest.ml

@@ -0,0 +1,19 @@
+open Jsonrpc_handler
+
+class json_request (rpc:jsonrpc_handler) = object (self)
+	val mutable requested_meta_list = None
+	(**
+		The contents of `params.meta` field of the request json
+	*)
+	method get_requested_meta_list : string list option =
+		match requested_meta_list with
+			| Some result -> result
+			| None ->
+				let result =
+					rpc#get_opt_param
+						(fun () -> Some (List.map (rpc#get_string "Metadata name") (rpc#get_array_param "meta")))
+						None
+				in
+				requested_meta_list <- Some result;
+				result
+end