[display] expose list of metadata/defines

src-prebuild/prebuild.ml

@@ -298,6 +298,18 @@ let parse_meta_usage = function
 	| \"TVariable\" -> TVariable
 	| t -> raise (failwith (\"invalid metadata target \" ^ t))
 
+let print_meta_usage = function
+	| TClass -> \"TClass\"
+	| TClassField -> \"TClassField\"
+	| TAbstract -> \"TAbstract\"
+	| TAbstractField -> \"TAbstractField\"
+	| TEnum -> \"TEnum\"
+	| TTypedef -> \"TTypedef\"
+	| TAnyField -> \"TAnyField\"
+	| TExpr -> \"TExpr\"
+	| TTypeParameter -> \"TTypeParameter\"
+	| TVariable -> \"TVariable\"
+
 type meta_parameter =
 	| HasParam of string
 	| Platforms of platform list

src/compiler/args.ml

@@ -162,7 +162,7 @@ let parse_args com =
 				let all,max_length = Define.get_user_documentation_list com.user_defines in
 				let all = List.map (fun (n,doc) -> Printf.sprintf " %-*s: %s" max_length n (limit_string doc (max_length + 3))) all in
 				List.iter (fun msg -> com.print (msg ^ "\n")) all;
-				exit 0
+				raise Abort
 			)
 		),"","print help for all user defines");
 		("Miscellaneous",["--help-metas"],[], Arg.Unit (fun() ->
@@ -177,7 +177,7 @@ let parse_args com =
 				let all,max_length = Meta.get_user_documentation_list com.user_metas in
 				let all = List.map (fun (n,doc) -> Printf.sprintf " %-*s: %s" max_length n (limit_string doc (max_length + 3))) all in
 				List.iter (fun msg -> com.print (msg ^ "\n")) all;
-				exit 0
+				raise Abort
 			)
 		),"","print help for all user metadatas");
 	] in

src/compiler/displayOutput.ml

@@ -67,8 +67,8 @@ let print_fields fields =
 		| ITPackage(path,_) -> "package",snd path,"",None
 		| ITModule path -> "type",snd path,"",None
 		| ITMetadata  meta ->
-			let s,(doc,_),_ = Meta.get_info meta in
-			"metadata","@" ^ s,"",doc_from_string doc
+			let s,data  = Meta.get_info meta in
+			"metadata","@" ^ s,"",doc_from_string data.m_doc
 		| ITTimer(name,value) -> "timer",name,"",doc_from_string value
 		| ITLiteral s ->
 			let t = match k.ci_type with None -> t_dynamic | Some (t,_) -> t in

src/context/display/displayJson.ml

@@ -155,6 +155,71 @@ let handler =
 			hctx.display#set_display_file (hctx.jsonrpc#get_bool_param "wasAutoTriggered") true;
 			hctx.display#enable_display DMSignature
 		);
+		"display/metadata", (fun hctx ->
+			let include_compiler_meta = hctx.jsonrpc#get_bool_param "compiler" in
+			let include_user_meta = hctx.jsonrpc#get_bool_param "user" in
+
+			hctx.com.callbacks#add_after_init_macros (fun () ->
+				let all = Meta.get_meta_list hctx.com.user_metas in
+				let all = List.filter (fun (_, (data:Meta.meta_infos)) ->
+					match data.m_origin with
+					| Compiler when include_compiler_meta -> true
+					| UserDefined _ when include_user_meta -> true
+					| _ -> false
+				) all in
+
+				hctx.send_result (jarray (List.map (fun (t, (data:Meta.meta_infos)) ->
+					let fields = [
+						"name", jstring t;
+						"doc", jstring data.m_doc;
+						"parameters", jarray (List.map jstring data.m_params);
+						"platforms", jarray (List.map (fun p -> jstring (platform_name p)) data.m_platforms);
+						"targets", jarray (List.map (fun u -> jstring (Meta.print_meta_usage u)) data.m_used_on);
+						"internal", jbool data.m_internal;
+						"origin", jstring (match data.m_origin with
+							| Compiler -> "haxe compiler"
+							| UserDefined None -> "user-defined"
+							| UserDefined (Some o) -> o
+						);
+						"links", jarray (List.map jstring data.m_links)
+					] in
+
+					(jobject fields)
+				) all))
+			)
+		);
+		"display/defines", (fun hctx ->
+			let include_compiler_defines = hctx.jsonrpc#get_bool_param "compiler" in
+			let include_user_defines = hctx.jsonrpc#get_bool_param "user" in
+
+			hctx.com.callbacks#add_after_init_macros (fun () ->
+				let all = Define.get_define_list hctx.com.user_defines in
+				let all = List.filter (fun (_, (data:Define.define_infos)) ->
+					match data.d_origin with
+					| Compiler when include_compiler_defines -> true
+					| UserDefined _ when include_user_defines -> true
+					| _ -> false
+				) all in
+
+				hctx.send_result (jarray (List.map (fun (t, (data:Define.define_infos)) ->
+					let fields = [
+						"name", jstring t;
+						"doc", jstring data.d_doc;
+						"parameters", jarray (List.map jstring data.d_params);
+						"platforms", jarray (List.map (fun p -> jstring (platform_name p)) data.d_platforms);
+						"origin", jstring (match data.d_origin with
+							| Compiler -> "haxe compiler"
+							| UserDefined None -> "user-defined"
+							| UserDefined (Some o) -> o
+						);
+						"deprecated", jopt jstring data.d_deprecated;
+						"links", jarray (List.map jstring data.d_links)
+					] in
+
+					(jobject fields)
+				) all))
+			)
+		);
 		"server/readClassPaths", (fun hctx ->
 			hctx.com.callbacks#add_after_init_macros (fun () ->
 				let cc = hctx.display#get_cs#get_context (Define.get_signature hctx.com.defines) in

src/core/define.ml

@@ -19,38 +19,59 @@ type define_origin =
 	| Compiler
 	| UserDefined of string option
 
-let infos ?user_defines d = match (user_defines,d) with
+type define_infos = {
+	d_doc : string;
+	d_params : string list;
+	d_platforms : Globals.platform list;
+	d_origin : define_origin;
+	d_links : string list;
+	d_deprecated : string option;
+}
+
+let infos ?user_defines d =
+	let extract_infos (t, (doc, flags), origin) =
+		let params = ref [] and pfs = ref [] and links = ref [] and deprecated = ref None in
+		List.iter (function
+			| HasParam s -> params := s :: !params
+			| Platforms fl -> pfs := fl @ !pfs
+			| Link url -> links := url :: !links
+			| Deprecated s -> deprecated := Some s
+		) flags;
+		(t, {
+			d_doc = doc;
+			d_params = !params;
+			d_platforms = !pfs;
+			d_origin = origin;
+			d_links = !links;
+			d_deprecated = !deprecated;
+		})
+	in
+
+	extract_infos (match (user_defines,d) with
 	| (Some(user_defines), Custom(s)) when (Hashtbl.mem user_defines s) ->
 		let infos = Hashtbl.find user_defines s in
 		(s, (infos.doc, infos.flags), (UserDefined infos.source))
 	| (_, Custom(s)) ->
 		(s, ("", []), Compiler)
 	| _ ->
 		let def,infos = DefineList.infos d in
-		(def, infos, Compiler)
+		(def, infos, Compiler))
 
 let get_define_key d =
-	match (infos d) with (s,_,_) -> s
+	match (infos d) with (s,_) -> s
 
 let get_documentation user_defines d =
-	let t, (doc,flags), origin = infos ~user_defines:user_defines d in
-	let params = ref [] and pfs = ref [] in
-	List.iter (function
-		| HasParam s -> params := s :: !params
-		| Platforms fl -> pfs := fl @ !pfs
-		| Link _ -> ()
-		| Deprecated _ -> ()
-	) flags;
-	let params = (match List.rev !params with
+	let t, data = infos ~user_defines:user_defines d in
+	let params = (match List.rev data.d_params with
 		| [] -> ""
 		| l -> "<" ^ String.concat ">, <" l ^ "> "
 	) in
-	let origin = match origin with
+	let origin = match data.d_origin with
 		| UserDefined Some s -> " (from " ^ s ^ ")"
 		| Compiler | UserDefined None -> ""
 	in
-	let pfs = platform_list_help (List.rev !pfs) in
-	(String.concat "-" (ExtString.String.nsplit t "_")), params ^ doc ^ pfs ^ origin
+	let pfs = platform_list_help (List.rev data.d_platforms) in
+	(String.concat "-" (ExtString.String.nsplit t "_")), params ^ data.d_doc ^ pfs ^ origin
 
 let get_documentation_list user_defines =
 	let m = ref 0 in
@@ -77,6 +98,16 @@ let get_user_documentation_list user_defines =
 	let all = List.sort (fun (s1,_) (s2,_) -> String.compare s1 s2) user_defines_list in
 	all,!m
 
+let get_define_list user_defines =
+	let rec loop i acc =
+		let d = Obj.magic i in
+		if d <> Last then (infos ~user_defines d) :: loop (i + 1) acc
+		else acc
+	in
+
+	let all = loop 0 (Hashtbl.fold (fun str _ acc -> (infos ~user_defines (Custom str)) :: acc) user_defines []) in
+	List.sort (fun (s1,_) (s2,_) -> String.compare s1 s2) all
+
 let raw_defined ctx k =
 	PMap.mem k ctx.values
 

src/core/display/completionItem.ml

@@ -761,42 +761,21 @@ let to_json ctx index item =
 		]
 		| ITMetadata meta ->
 			let open Meta in
-			let name,(doc,params),origin = Meta.get_info meta in
+			let name,data = Meta.get_info meta in
 			let name = "@" ^ name in
-			let usage_to_string = function
-				| TClass -> "TClass"
-				| TClassField -> "TClassField"
-				| TAbstract -> "TAbstract"
-				| TAbstractField -> "TAbstractField"
-				| TEnum -> "TEnum"
-				| TTypedef -> "TTypedef"
-				| TAnyField -> "TAnyField"
-				| TExpr -> "TExpr"
-				| TTypeParameter -> "TTypeParameter"
-				| TVariable -> "TVariable"
-			in
-			let origin = match origin with
-				| Compiler -> Some "haxe compiler"
-				| UserDefined s -> s
-			in
-			let rec loop internal params platforms targets links l = match l with
-				| HasParam s :: l -> loop internal (s :: params) platforms targets links l
-				| Platforms pls :: l -> loop internal params ((List.map platform_name pls) @ platforms) targets links l
-				| UsedOn usages :: l -> loop internal params platforms ((List.map usage_to_string usages) @ targets) links l
-				| UsedInternally :: l -> loop true params platforms targets links l
-				| Link url :: l -> loop internal params platforms targets (url :: links) l
-				| [] -> internal,params,platforms,targets,links
-			in
-			let internal,params,platforms,targets,links = loop false [] [] [] [] params in
 			"Metadata",jobject [
-				"name",jstring name;
-				"doc",jstring doc;
-				"parameters",jlist jstring params;
-				"platforms",jlist jstring platforms;
-				"targets",jlist jstring targets;
-				"internal",jbool internal;
-				"links",jlist jstring links;
-				"origin",jopt jstring origin;
+				"name", jstring name;
+				"doc", jstring data.m_doc;
+				"parameters", jarray (List.map jstring data.m_params);
+				"platforms", jarray (List.map (fun p -> jstring (platform_name p)) data.m_platforms);
+				"targets", jarray (List.map (fun u -> jstring (Meta.print_meta_usage u)) data.m_used_on);
+				"internal", jbool data.m_internal;
+				"origin", jstring (match data.m_origin with
+					| Compiler -> "haxe compiler"
+					| UserDefined None -> "user-defined"
+					| UserDefined (Some o) -> o
+				);
+				"links", jarray (List.map jstring data.m_links)
 			]
 		| ITKeyword kwd ->"Keyword",jobject [
 			"name",jstring (s_keyword kwd)

src/core/json/genjson.ml

@@ -177,8 +177,8 @@ and generate_metadata_entry ctx (m,el,p) =
 
 and generate_metadata ctx ml =
 	let ml = List.filter (fun (m,_,_) ->
-		let (_,(_,flags),_) = Meta.get_info m in
-		not (List.mem UsedInternally flags)
+		let (_,data) = Meta.get_info m in
+		not data.m_internal
 	) ml in
 	jlist (generate_metadata_entry ctx) ml
 

src/core/meta.ml

@@ -20,18 +20,49 @@ type meta_origin =
 	| Compiler
 	| UserDefined of string option
 
+type meta_infos = {
+	m_internal : bool;
+	m_doc : string;
+	m_params : string list;
+	m_platforms : Globals.platform list;
+	m_used_on : meta_usage list;
+	m_origin : meta_origin;
+	m_links : string list;
+}
+
 let register_user_meta user_metas s data =
 	Hashtbl.replace user_metas s data
 
-let get_info ?user_metas m = match (user_metas,m) with
+let get_info ?user_metas m =
+	let extract_infos (t, (doc, flags), origin) =
+			let params = ref [] and used = ref [] and pfs = ref [] and links = ref [] and internal = ref false in
+			List.iter (function
+				| HasParam s -> params := s :: !params
+				| Platforms fl -> pfs := fl @ !pfs
+				| UsedOn ul -> used := ul @ !used
+				| UsedInternally -> internal := true
+				| Link url -> links := url :: !links
+			) flags;
+			(t,{
+				m_internal = !internal;
+				m_doc = doc;
+				m_params = !params;
+				m_platforms = !pfs;
+				m_used_on = !used;
+				m_origin = origin;
+				m_links = !links;
+			})
+	in
+
+	extract_infos (match (user_metas,m) with
 	| (Some(user_metas), Custom(s)) when (Hashtbl.mem user_metas s) ->
 		let infos = Hashtbl.find user_metas s in
 		(s, (infos.doc, infos.flags), (UserDefined infos.source))
 	| _ ->
 		let meta,infos = MetaList.get_info m in
-		(meta, infos, Compiler)
+		(meta, infos, Compiler))
 
-let to_string m = match (get_info m) with (s,_,_) -> s
+let to_string m = match (get_info m) with (s,_) -> s
 
 let hmeta =
 	let h = Hashtbl.create 0 in
@@ -53,30 +84,19 @@ let from_string s =
 	| '$' -> Dollar (String.sub s 1 (String.length s - 1))
 	| _ -> Custom s
 
-let get_documentation user_metas d =
-	let t, (doc,flags), origin = get_info ~user_metas:user_metas d in
-	if not (List.mem UsedInternally flags) then begin
-		let params = ref [] and used = ref [] and pfs = ref [] in
-		List.iter (function
-			| HasParam s -> params := s :: !params
-			| Platforms fl -> pfs := fl @ !pfs
-			| UsedOn ul -> used := ul @ !used
-			| UsedInternally -> die "" __LOC__
-			| Link _ -> ()
-		) flags;
-		let params = (match List.rev !params with
+let get_documentation user_metas m =
+	let t, data = get_info ~user_metas:user_metas m in
+	if data.m_internal then None else
+		let params = (match List.rev data.m_params with
 			| [] -> ""
 			| l -> "(<" ^ String.concat ">, <" l ^ ">) "
 		) in
-		let pfs = platform_list_help (List.rev !pfs) in
-		let origin = match origin with
+		let pfs = platform_list_help (List.rev data.m_platforms) in
+		let origin = match data.m_origin with
 			| UserDefined Some s -> " (from " ^ s ^ ")"
 			| Compiler | UserDefined None -> ""
 		in
-		let str = "@" ^ t in
-		Some (str,params ^ doc ^ pfs ^ origin)
-	end else
-		None
+		Some ("@" ^ t, params ^ data.m_doc ^ pfs ^ origin)
 
 let get_documentation_list user_metas =
 	let m = ref 0 in
@@ -93,6 +113,16 @@ let get_documentation_list user_metas =
 	let all = List.sort (fun (s1,_) (s2,_) -> String.compare s1 s2) (loop 0) in
 	all,!m
 
+let get_meta_list user_metas =
+	let rec loop i acc =
+		let d = Obj.magic i in
+		if d <> Last then (get_info ~user_metas d) :: loop (i + 1) acc
+		else acc
+	in
+
+	let all = loop 0 (Hashtbl.fold (fun str _ acc -> (get_info ~user_metas (Custom str)) :: acc) user_metas []) in
+	List.sort (fun (s1,_) (s2,_) -> String.compare s1 s2) all
+
 let get_all user_metas =
 	let rec loop i acc =
 		let d = Obj.magic i in
@@ -108,7 +138,7 @@ let get_user_documentation_list user_metas =
 	let user_meta_list = (Hashtbl.fold (fun meta _ acc ->
 		begin match get_documentation user_metas (Custom meta) with
 			| None -> acc
-			| Some (str, desc) ->
+			| Some (str,desc) ->
 				if String.length str > !m then m := String.length str;
 				(str,desc) :: acc
 		end