make diagnostics messages more flexible

src/display/display.ml

@@ -369,8 +369,8 @@ module Diagnostics = struct
 
 	let print_diagnostics com =
 		let diag = DynArray.create() in
-		let add dk p args =
-			DynArray.add diag (dk,p,args)
+		let add dk p sev args =
+			DynArray.add diag (dk,p,sev,args)
 		in
 		begin match !(Common.global_cache) with
 			| None ->
@@ -397,17 +397,22 @@ module Diagnostics = struct
 						"name",JString s
 					]
 				) suggestions in
-				add DKUnresolvedIdentifier p (suggestions @ (find_type s));
+				add DKUnresolvedIdentifier p DiagnosticsSeverity.Error (suggestions @ (find_type s));
 			) com.display_information.unresolved_identifiers;
 		end;
 		PMap.iter (fun p r ->
-			if not !r then add DKUnusedImport p []
+			if not !r then add DKUnusedImport p DiagnosticsSeverity.Warning []
 		) com.shared.shared_display_information.import_positions;
-		List.iter (fun (s,p) ->
-			add DKCompilerError p [JString s]
-		) com.shared.shared_display_information.compiler_errors;
-		let jl = DynArray.fold_left (fun acc (dk,p,args) ->
-			(JObject ["kind",JInt (to_int dk);"range",pos_to_json_range p;"args",JArray args]) :: acc
+		List.iter (fun (s,p,sev) ->
+			add DKCompilerError p sev [JString s]
+		) com.shared.shared_display_information.diagnostics_messages;
+		let jl = DynArray.fold_left (fun acc (dk,p,sev,args) ->
+			(JObject [
+				"kind",JInt (to_int dk);
+				"severity",JInt (DiagnosticsSeverity.to_int sev);
+				"range",pos_to_json_range p;
+				"args",JArray args
+			]) :: acc
 		) [] diag in
 		let js = JArray jl in
 		let b = Buffer.create 0 in

src/main.ml

@@ -1466,7 +1466,7 @@ try
 	process ctx.com.args;
 	process_libs();
 	if com.display <> DMNone then begin
-		com.warning <- message ctx;
+		com.warning <- if com.display = DMDiagnostics then (fun s p -> add_diagnostics_message com s p DiagnosticsSeverity.Warning) else message ctx;
 		com.error <- error ctx;
 		com.main_class <- None;
 		if com.display <> DMUsage then
@@ -1612,7 +1612,9 @@ try
 		com.modules <- modules;
 		begin match com.display with
 			| DMUsage -> Codegen.detect_usage com;
-			| DMDiagnostics -> raise (Display.Diagnostics (Display.Diagnostics.print_diagnostics ctx.com))
+			| DMDiagnostics ->
+				Codegen.DeprecationCheck.run com;
+				raise (Display.Diagnostics (Display.Diagnostics.print_diagnostics ctx.com))
 			| _ -> ()
 		end;
 		Filters.run com tctx main;

src/typing/common.ml

@@ -126,9 +126,23 @@ module IdentifierType = struct
 		| ITPackage s -> s
 end
 
+module DiagnosticsSeverity = struct
+	type t =
+		| Error
+		| Warning
+		| Information
+		| Hint
+
+	let to_int = function
+		| Error -> 1
+		| Warning -> 2
+		| Information -> 3
+		| Hint -> 4
+end
+
 type shared_display_information = {
 	mutable import_positions : (pos,bool ref) PMap.t;
-	mutable compiler_errors : (string * pos) list;
+	mutable diagnostics_messages : (string * pos * DiagnosticsSeverity.t) list;
 }
 
 type display_information = {
@@ -715,7 +729,7 @@ let create version s_version args =
 		shared = {
 			shared_display_information = {
 				import_positions = PMap.empty;
-				compiler_errors = [];
+				diagnostics_messages = [];
 			}
 		};
 		display_information = {
@@ -1125,6 +1139,7 @@ let float_repres f =
 			Printf.sprintf "%.18g" f
 		in valid_float_lexeme float_val
 
-let add_diagnostics_error com s p =
+
+let add_diagnostics_message com s p sev =
 	let di = com.shared.shared_display_information in
-	di.compiler_errors <- (s,p) :: di.compiler_errors
+	di.diagnostics_messages <- (s,p,sev) :: di.diagnostics_messages

src/typing/typecore.ml

@@ -232,7 +232,7 @@ let pass_name = function
 	| PFinal -> "final"
 
 let display_error ctx msg p = match ctx.com.display with
-	| DMDiagnostics -> add_diagnostics_error ctx.com msg p
+	| DMDiagnostics -> add_diagnostics_message ctx.com msg p DiagnosticsSeverity.Error
 	| _ -> ctx.on_error ctx msg p
 
 let error msg p = raise (Error (Custom msg,p))
@@ -259,16 +259,10 @@ let make_static_call ctx c cf map args t p =
 	let ef = make_static_field_access c cf (map cf.cf_type) p in
 	make_call ctx ef args (map t) p
 
-let raise_or_display ctx l p = match ctx.com.display with
-	| DMDiagnostics when ctx.is_display_file ->
-		let di = ctx.com.shared.shared_display_information in
-		di.compiler_errors <- (error_msg (Unify l),p) :: di.compiler_errors
-	| DMNone when ctx.untyped -> ()
-	| DMNone ->
-		if ctx.in_call_args then raise (WithTypeError(l,p))
-		else display_error ctx (error_msg (Unify l)) p
-	| _ ->
-		()
+let raise_or_display ctx l p =
+	if ctx.untyped then ()
+	else if ctx.in_call_args then raise (WithTypeError(l,p))
+	else display_error ctx (error_msg (Unify l)) p
 
 let raise_or_display_message ctx msg p =
 	if ctx.in_call_args then raise (WithTypeError ([Unify_custom msg],p))