Skip to content

Commit

Permalink
[display] expose list of metadata/defines (#11399)
Browse files Browse the repository at this point in the history
* [display] expose meta list (including user defined ones)

* [display] expose defines list (including user defined ones)

* add user vs compiler filtering

* cleanup
  • Loading branch information
kLabz committed Feb 18, 2024
1 parent 2dcf037 commit 95fafa7
Show file tree
Hide file tree
Showing 10 changed files with 325 additions and 77 deletions.
12 changes: 12 additions & 0 deletions src-prebuild/prebuild.ml
Expand Up @@ -286,6 +286,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
Expand Down
4 changes: 2 additions & 2 deletions src/compiler/args.ml
Expand Up @@ -158,7 +158,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() ->
Expand All @@ -173,7 +173,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
Expand Down
4 changes: 2 additions & 2 deletions src/compiler/displayOutput.ml
Expand Up @@ -71,8 +71,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
Expand Down
65 changes: 65 additions & 0 deletions src/context/display/displayJson.ml
Expand Up @@ -156,6 +156,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
Expand Down
61 changes: 46 additions & 15 deletions src/core/define.ml
Expand Up @@ -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
Expand All @@ -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

Expand Down
47 changes: 13 additions & 34 deletions src/core/display/completionItem.ml
Expand Up @@ -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)
Expand Down
4 changes: 2 additions & 2 deletions src/core/json/genjson.ml
Expand Up @@ -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

Expand Down
74 changes: 52 additions & 22 deletions src/core/meta.ml
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down

0 comments on commit 95fafa7

Please sign in to comment.