[display] add missing field diagnostics

src/context/common.ml

@@ -239,9 +239,25 @@ type shared_display_information = {
 	mutable diagnostics_messages : (string * pos * DisplayTypes.DiagnosticsKind.t * DisplayTypes.DiagnosticsSeverity.t) list;
 }
 
+(* diagnostics *)
+
+type missing_field_cause =
+	| AbstractParent of tclass * tparams
+	| ImplementedInterface of tclass * tparams
+
+and missing_fields_diagnostics = {
+	mf_on : tclass;
+	mf_fields : (tclass_field * Type.t * CompletionItem.CompletionType.t) list;
+	mf_cause : missing_field_cause;
+}
+
+and module_diagnostics =
+	| MissingFields of missing_fields_diagnostics
+
 type display_information = {
 	mutable unresolved_identifiers : (string * pos * (string * CompletionItem.t * int) list) list;
 	mutable display_module_has_macro_defines : bool;
+	mutable module_diagnostics : module_diagnostics list;
 }
 
 (* This information is shared between normal and macro context. *)
@@ -640,6 +656,7 @@ let create version s_version args =
 		display_information = {
 			unresolved_identifiers = [];
 			display_module_has_macro_defines = false;
+			module_diagnostics = [];
 		};
 		sys_args = args;
 		debug = false;
@@ -720,6 +737,7 @@ let clone com =
 		display_information = {
 			unresolved_identifiers = [];
 			display_module_has_macro_defines = false;
+			module_diagnostics = [];
 		};
 		defines = {
 			values = com.defines.values;

src/context/display/diagnostics.ml

@@ -105,6 +105,7 @@ let prepare com =
 		dead_blocks = Hashtbl.create 0;
 		diagnostics_messages = [];
 		unresolved_identifiers = [];
+		missing_fields = PMap.empty;
 	} in
 	List.iter (function
 		| TClassDecl c when DiagnosticsPrinter.is_diagnostics_file (com.file_keys#get c.cl_pos.pfile) ->
@@ -147,8 +148,18 @@ let prepare com =
 					let b' = PMap.find p dctx.import_positions in
 					b' := true
 				end
-			) m.m_extra.m_display.m_import_positions
-		) com.modules
+			) m.m_extra.m_display.m_import_positions;
+		) com.modules;
+		List.iter (function
+			| MissingFields mf ->
+				let p = mf.mf_on.cl_name_pos in
+				begin try
+					let _,l = PMap.find p dctx.missing_fields in
+					l := mf :: !l
+				with Not_found ->
+					dctx.missing_fields <- PMap.add p (mf.mf_on,ref [mf]) dctx.missing_fields
+				end
+		) com.display_information.module_diagnostics
 	in
 	process_modules com;
 	begin match com.get_macros() with

src/context/display/diagnosticsPrinter.ml

@@ -1,9 +1,12 @@
 open Globals
+open Common
 open Json
 open DisplayTypes
 open DiagnosticsKind
 open DisplayTypes
 open DiagnosticsTypes
+open TType
+open Genjson
 
 type t = DiagnosticsKind.t * pos
 
@@ -74,6 +77,54 @@ let json_of_diagnostics dctx =
 	List.iter (fun (s,p,prange) ->
 		add DKRemovableCode p DiagnosticsSeverity.Warning (JObject ["description",JString s;"range",if prange = null_pos then JNull else Genjson.generate_pos_as_range prange])
 	) dctx.removable_code;
+	PMap.iter (fun p (c,mfl) ->
+		let jctx = create_context GMMinimum in
+		let all_fields = ref [] in
+		let create mf =
+			let kind,args = match mf.mf_cause with
+				| AbstractParent(csup,tl) ->
+					"AbstractParent",jobject [
+						"parent",generate_type_path_with_params jctx csup.cl_module.m_path csup.cl_path tl csup.cl_meta;
+					]
+				| ImplementedInterface(ci,tl) ->
+					"ImplementedInterface",jobject [
+						"parent",generate_type_path_with_params jctx ci.cl_module.m_path ci.cl_path tl ci.cl_meta;
+					]
+			in
+			let current_fields = ref [] in
+			let map_field (cf,t,ct) =
+				let cf = {cf with cf_overloads = []} in
+				if List.exists (fun (t2,cf2) -> cf.cf_name = cf2.cf_name && Overloads.same_overload_args t t2 cf cf2) !current_fields then
+					None
+				else begin
+					(* With multiple interfaces there can be duplicates, which would be bad for the "Implement all" code action. *)
+					let unique = not (List.exists (fun (t2,cf2) -> cf.cf_name = cf2.cf_name && Overloads.same_overload_args t t2 cf cf2) !all_fields) in
+					current_fields := (t,cf) :: !current_fields;
+					all_fields := (t,cf) :: !all_fields;
+					Some (jobject [
+						"field",generate_class_field jctx CFSMember cf;
+						"type",CompletionType.generate_type jctx ct;
+						"unique",jbool unique;
+					])
+				end
+			in
+			let fields = ExtList.List.filter_map map_field mf.mf_fields in
+			jobject [
+				"fields",jarray fields;
+				"cause",jobject [
+					"kind",jstring kind;
+					"args",args
+				]
+			]
+		in
+		(* cl_interfaces is reversed, let's reverse the order again here *)
+		let l = List.map create (List.rev !mfl) in
+		let j = jobject [
+			"classPath",class_ref jctx c;
+			"entries",jarray l
+		] in
+		add DKMissingFields p DiagnosticsSeverity.Error j
+	) dctx.missing_fields;
 	Hashtbl.iter (fun _ (s,p) ->
 		add DKDeprecationWarning p DiagnosticsSeverity.Warning (JString s);
 	) DeprecationCheck.warned_positions;

src/context/display/diagnosticsTypes.ml

@@ -1,5 +1,7 @@
 open Globals
 open Ast
+open Type
+open Common
 
 type diagnostics_context = {
 	mutable removable_code : (string * pos * pos) list;
@@ -7,4 +9,5 @@ type diagnostics_context = {
 	mutable dead_blocks : (Path.UniqueKey.t,(pos * expr) list) Hashtbl.t;
 	mutable unresolved_identifiers : (string * pos * (string * CompletionItem.t * int) list) list;
 	mutable diagnostics_messages : (string * pos * DisplayTypes.DiagnosticsKind.t * DisplayTypes.DiagnosticsSeverity.t) list;
+	mutable missing_fields : (pos,(tclass * (missing_fields_diagnostics list ref))) PMap.t;
 }

src/core/displayTypes.ml

@@ -86,6 +86,7 @@ module DiagnosticsKind = struct
 		| DKParserError
 		| DKDeprecationWarning
 		| DKInactiveBlock
+		| DKMissingFields
 
 	let to_int = function
 		| DKUnusedImport -> 0
@@ -95,6 +96,7 @@ module DiagnosticsKind = struct
 		| DKParserError -> 4
 		| DKDeprecationWarning -> 5
 		| DKInactiveBlock -> 6
+		| DKMissingFields -> 7
 end
 
 module CompletionResultKind = struct

src/typing/typeloadCheck.ml

@@ -335,14 +335,13 @@ module Inheritance = struct
 			end
 		| _ -> error "Should extend by using a class" p
 
-	let rec check_interface ctx c intf params =
+	let rec check_interface ctx missing c intf params =
+		List.iter (fun (i2,p2) ->
+			check_interface ctx missing c i2 (List.map (apply_params intf.cl_params params) p2)
+		) intf.cl_implements;
 		let p = c.cl_name_pos in
 		let rec check_field i f =
-			(if ctx.com.config.pf_overload then
-				List.iter (function
-					| f2 when f != f2 ->
-							check_field i f2
-					| _ -> ()) f.cf_overloads);
+			let t = (apply_params intf.cl_params params f.cf_type) in
 			let is_overload = ref false in
 			try
 				let t2, f2 = class_field_no_interf c i in
@@ -350,7 +349,6 @@ module Inheritance = struct
 					if ctx.com.config.pf_overload && (f2.cf_overloads <> [] || Meta.has Meta.Overload f2.cf_meta) then
 						let overloads = Overloads.get_overloads ctx.com c i in
 						is_overload := true;
-						let t = (apply_params intf.cl_params params f.cf_type) in
 						List.find (fun (t1,f1) -> Overloads.same_overload_args t t1 f f1) overloads
 					else
 						t2, f2
@@ -386,27 +384,46 @@ module Inheritance = struct
 						TClass.add_field c cf
 					end
 				| Not_found when not (has_class_flag c CInterface) ->
-					let msg = if !is_overload then
-						let ctx = print_context() in
-						let args = match follow f.cf_type with | TFun(args,_) -> String.concat ", " (List.map (fun (n,o,t) -> (if o then "?" else "") ^ n ^ " : " ^ (s_type ctx t)) args) | _ -> die "" __LOC__ in
-						"No suitable overload for " ^ i ^ "( " ^ args ^ " ), as needed by " ^ s_type_path intf.cl_path ^ " was found"
-					else
-						("Field " ^ i ^ " needed by " ^ s_type_path intf.cl_path ^ " is missing")
-					in
-					display_error ctx msg p
+					if Diagnostics.is_diagnostics_run ctx.com c.cl_pos then
+						DynArray.add missing (f,t)
+					else begin
+						let msg = if !is_overload then
+							let ctx = print_context() in
+							let args = match follow f.cf_type with | TFun(args,_) -> String.concat ", " (List.map (fun (n,o,t) -> (if o then "?" else "") ^ n ^ " : " ^ (s_type ctx t)) args) | _ -> die "" __LOC__ in
+							"No suitable overload for " ^ i ^ "( " ^ args ^ " ), as needed by " ^ s_type_path intf.cl_path ^ " was found"
+						else
+							("Field " ^ i ^ " needed by " ^ s_type_path intf.cl_path ^ " is missing")
+						in
+						display_error ctx msg p
+					end
 				| Not_found -> ()
 		in
-		PMap.iter check_field intf.cl_fields;
-		List.iter (fun (i2,p2) ->
-			check_interface ctx c i2 (List.map (apply_params intf.cl_params params) p2)
-		) intf.cl_implements
+		let check_field i cf =
+			check_field i cf;
+			if ctx.com.config.pf_overload then
+				List.iter (check_field i) (List.rev cf.cf_overloads)
+		in
+		PMap.iter check_field intf.cl_fields
 
 	let check_interfaces ctx c =
 		match c.cl_path with
 		| "Proxy" :: _ , _ -> ()
 		| _ when (has_class_flag c CExtern) && Meta.has Meta.CsNative c.cl_meta -> ()
 		| _ ->
-		List.iter (fun (intf,params) -> check_interface ctx c intf params) c.cl_implements
+		List.iter (fun (intf,params) ->
+			let missing = DynArray.create () in
+			check_interface ctx missing c intf params;
+			if DynArray.length missing > 0 then begin
+				let l = DynArray.to_list missing in
+				let diag = {
+					mf_on = c;
+					mf_fields = List.map (fun (cf,t) -> (cf,t,CompletionType.from_type (Display.get_import_status ctx) t)) l;
+					mf_cause = ImplementedInterface(intf,params);
+				} in
+				let display = ctx.com.display_information in
+				display.module_diagnostics <- MissingFields diag :: display.module_diagnostics
+			end
+		) c.cl_implements
 
 	let check_abstract_class ctx c csup params =
 		let missing = ref [] in
@@ -417,9 +434,9 @@ module Inheritance = struct
 				if not (List.exists (fun cf2 ->
 					Overloads.same_overload_args t1 cf2.cf_type cf1 cf2
 				) (cf2 :: cf2.cf_overloads)) then
-					missing := cf1 :: !missing
+					missing := (cf1,t1) :: !missing
 			with Not_found ->
-				missing := cf1 :: !missing
+				missing := (cf1,t1) :: !missing
 		in
 		let cfl = TClass.get_all_fields csup params in
 		PMap.iter (fun _ (_,cf) ->
@@ -432,12 +449,20 @@ module Inheritance = struct
 		match !missing with
 		| [] ->
 			()
+		| l when Diagnostics.is_diagnostics_run ctx.com c.cl_pos ->
+			let diag = {
+				mf_on = c;
+				mf_fields = List.rev_map (fun (cf,t) -> (cf,t,CompletionType.from_type (Display.get_import_status ctx) t)) l;
+				mf_cause = AbstractParent(csup,params);
+			} in
+			let display = ctx.com.display_information in
+			display.module_diagnostics <- MissingFields diag :: display.module_diagnostics
 		| l ->
 			let singular = match l with [_] -> true | _ -> false in
 			display_error ctx (Printf.sprintf "This class extends abstract class %s but doesn't implement the following method%s" (s_type_path csup.cl_path) (if singular then "" else "s")) c.cl_name_pos;
 			display_error ctx (Printf.sprintf "Implement %s or make %s abstract as well" (if singular then "it" else "them") (s_type_path c.cl_path)) c.cl_name_pos;
 			let pctx = print_context() in
-			List.iter (fun cf ->
+			List.iter (fun (cf,_) ->
 				let s = match follow cf.cf_type with
 					| TFun(tl,tr) ->
 						String.concat ", " (List.map (fun (n,o,t) -> Printf.sprintf "%s:%s" n (s_type pctx t)) tl)