[display] diagnostics as json rpc

src/compiler/compiler.ml

@@ -2,29 +2,35 @@ open Globals
 open Common
 open CompilationContext
 
-let run_or_diagnose ctx f arg =
+let run_or_diagnose ctx f =
 	let com = ctx.com in
-	let handle_diagnostics ?(depth = 0) msg p kind =
+	let handle_diagnostics msg p kind =
 		ctx.has_error <- true;
-		add_diagnostics_message ~depth com msg p kind Error;
-		DisplayOutput.emit_diagnostics ctx.com
+		add_diagnostics_message com msg p kind Error;
+		match com.report_mode with
+		| RMLegacyDiagnostics _ -> DisplayOutput.emit_legacy_diagnostics ctx.com
+		| RMDiagnostics _ -> DisplayOutput.emit_diagnostics ctx.com
+		| _ -> die "" __LOC__
 	in
 	if is_diagnostics com then begin try
-			f arg
+			f ()
 		with
 		| Error.Error err ->
 			ctx.has_error <- true;
 			Error.recurse_error (fun depth err ->
 				add_diagnostics_message ~depth com (Error.error_msg err.err_message) err.err_pos DKCompilerMessage Error
 			) err;
-			DisplayOutput.emit_diagnostics ctx.com
+			(match com.report_mode with
+			| RMLegacyDiagnostics _ -> DisplayOutput.emit_legacy_diagnostics ctx.com
+			| RMDiagnostics _ -> DisplayOutput.emit_diagnostics ctx.com
+			| _ -> die "" __LOC__)
 		| Parser.Error(msg,p) ->
 			handle_diagnostics (Parser.error_msg msg) p DKParserError
 		| Lexer.Error(msg,p) ->
 			handle_diagnostics (Lexer.error_msg msg) p DKParserError
 		end
 	else
-		f arg
+		f ()
 
 let run_command ctx cmd =
 	let t = Timer.timer ["command";cmd] in
@@ -297,7 +303,7 @@ let do_type ctx mctx actx display_file_dot_path macro_cache_enabled =
 			if com.display.dms_kind <> DMNone then DisplayTexpr.check_display_file tctx cs;
 			List.iter (fun cpath -> ignore(tctx.Typecore.g.Typecore.do_load_module tctx cpath null_pos)) (List.rev actx.classes);
 			Finalization.finalize tctx;
-		) ();
+		);
 	end with TypeloadParse.DisplayInMacroBlock ->
 		ignore(DisplayProcessing.load_display_module_in_macro tctx display_file_dot_path true)
 	);
@@ -317,7 +323,7 @@ let finalize_typing ctx tctx =
 	let com = ctx.com in
 	enter_stage com CFilteringStart;
 	ServerMessage.compiler_stage com;
-	let main, types, modules = run_or_diagnose ctx Finalization.generate tctx in
+	let main, types, modules = run_or_diagnose ctx (fun () -> Finalization.generate tctx) in
 	com.main <- main;
 	com.types <- types;
 	com.modules <- modules;
@@ -326,7 +332,7 @@ let finalize_typing ctx tctx =
 let filter ctx tctx before_destruction =
 	let t = Timer.timer ["filters"] in
 	DeprecationCheck.run ctx.com;
-	run_or_diagnose ctx Filters.run tctx ctx.com.main before_destruction;
+	run_or_diagnose ctx (fun () -> Filters.run tctx ctx.com.main before_destruction);
 	t()
 
 let compile ctx actx callbacks =

src/compiler/displayOutput.ml

@@ -368,12 +368,22 @@ let handle_type_path_exception ctx p c is_import pos =
 		api.send_result (DisplayException.fields_to_json ctx fields kind (DisplayTypes.make_subject None pos));
 	end
 
-let emit_diagnostics com =
+let emit_legacy_diagnostics com =
 	let dctx = Diagnostics.run com in
 	let s = Json.string_of_json (DiagnosticsPrinter.json_of_diagnostics com dctx) in
 	DisplayPosition.display_position#reset;
 	raise (Completion s)
 
+let emit_diagnostics com =
+	(match com.Common.json_out with
+	| None -> die "" __LOC__
+	| Some api ->
+		let dctx = Diagnostics.run com in
+		let diagnostics = DiagnosticsPrinter.json_of_diagnostics com dctx in
+		DisplayPosition.display_position#reset;
+		api.send_result diagnostics;
+		raise Abort (* not reached because send_result always raises *))
+
 let emit_statistics tctx =
 	let stats = Statistics.collect_statistics tctx [SFFile (DisplayPosition.display_position#get).pfile] true in
 	let s = Statistics.Printer.print_statistics stats in

src/compiler/displayProcessing.ml

@@ -22,7 +22,7 @@ let handle_display_argument_old com file_pos actx =
 		actx.did_something <- true;
 		(try Memory.display_memory com with e -> prerr_endline (Printexc.get_backtrace ()));
 	| "diagnostics" ->
-		com.report_mode <- RMDiagnostics []
+		com.report_mode <- RMLegacyDiagnostics []
 	| _ ->
 		let file, pos = try ExtString.String.split file_pos "@" with _ -> failwith ("Invalid format: " ^ file_pos) in
 		let file = Helper.unquote file in
@@ -46,7 +46,7 @@ let handle_display_argument_old com file_pos actx =
 			| "module-symbols" ->
 				create (DMModuleSymbols None)
 			| "diagnostics" ->
-				com.report_mode <- RMDiagnostics [file_unique];
+				com.report_mode <- RMLegacyDiagnostics [file_unique];
 				let dm = create DMNone in
 				{dm with dms_display_file_policy = DFPAlso; dms_per_file = true; dms_populate_cache = !ServerConfig.populate_cache_from_display}
 			| "statistics" ->
@@ -348,6 +348,8 @@ let handle_display_after_finalization ctx tctx display_file_dot_path =
 	end;
 	process_global_display_mode com tctx;
 	begin match com.report_mode with
+	| RMLegacyDiagnostics _ ->
+		DisplayOutput.emit_legacy_diagnostics com
 	| RMDiagnostics _ ->
 		DisplayOutput.emit_diagnostics com
 	| RMStatistics ->

src/compiler/server.ml

@@ -16,15 +16,7 @@ let has_error ctx =
 	ctx.has_error || ctx.com.Common.has_error
 
 let check_display_flush ctx f_otherwise = match ctx.com.json_out with
-	| None ->
-		if is_diagnostics ctx.com then begin
-			List.iter (fun cm ->
-				add_diagnostics_message ~depth:cm.cm_depth ctx.com cm.cm_message cm.cm_pos cm.cm_kind cm.cm_severity
-			) (List.rev ctx.messages);
-			raise (Completion (Diagnostics.print ctx.com))
-		end else
-			f_otherwise ()
-	| Some api ->
+	| Some api when not (is_diagnostics ctx.com) ->
 		if has_error ctx then begin
 			let errors = List.map (fun cm ->
 				JObject [
@@ -35,6 +27,17 @@ let check_display_flush ctx f_otherwise = match ctx.com.json_out with
 			) (List.rev ctx.messages) in
 			api.send_error errors
 		end
+	| _ ->
+		if is_diagnostics ctx.com then begin
+			List.iter (fun cm ->
+				add_diagnostics_message ~depth:cm.cm_depth ctx.com cm.cm_message cm.cm_pos cm.cm_kind cm.cm_severity
+			) (List.rev ctx.messages);
+			(match ctx.com.report_mode with
+			| RMDiagnostics _ -> ()
+			| RMLegacyDiagnostics _ -> raise (Completion (Diagnostics.print ctx.com))
+			| _ -> die "" __LOC__)
+		end else
+			f_otherwise ()
 
 let current_stdin = ref None
 

src/context/common.ml

@@ -289,7 +289,8 @@ let s_compiler_stage = function
 
 type report_mode =
 	| RMNone
-	| RMDiagnostics of Path.UniqueKey.t list
+	| RMLegacyDiagnostics of (Path.UniqueKey.t list)
+	| RMDiagnostics of (Path.UniqueKey.t * string option (* file contents *)) list
 	| RMStatistics
 
 class virtual ['key,'value] lookup = object(self)
@@ -890,7 +891,7 @@ let create compilation_step cs version args =
 	com
 
 let is_diagnostics com = match com.report_mode with
-	| RMDiagnostics _ -> true
+	| RMLegacyDiagnostics _ | RMDiagnostics _ -> true
 	| _ -> false
 
 let disable_report_mode com =

src/context/display/diagnosticsPrinter.ml

@@ -26,8 +26,9 @@ let make_diagnostic kd p sev code args = {
 
 let is_diagnostics_file com file_key =
 	match com.report_mode with
-	| RMDiagnostics [] -> true
-	| RMDiagnostics file_keys -> List.exists (fun key' -> file_key = key') file_keys
+	| RMLegacyDiagnostics [] | RMDiagnostics [] -> true
+	| RMLegacyDiagnostics file_keys -> List.exists (fun key' -> file_key = key') file_keys
+	| RMDiagnostics file_keys -> List.exists (fun (key',_) -> file_key = key') file_keys
 	| _ -> false
 
 module UnresolvedIdentifierSuggestion = struct

src/context/display/displayJson.ml

@@ -125,6 +125,55 @@ let handler =
 			hctx.display#set_display_file false true;
 			hctx.display#enable_display DMDefinition;
 		);
+		"display/diagnostics", (fun hctx ->
+			hctx.display#enable_display DMNone;
+
+			let file = hctx.jsonrpc#get_opt_param (fun () ->
+				let file = hctx.jsonrpc#get_string_param "file" in
+				Path.get_full_path file
+			) file_input_marker in
+
+			if file <> file_input_marker then begin
+				let file_unique = hctx.com.file_keys#get file in
+
+				let contents = hctx.jsonrpc#get_opt_param (fun () ->
+					let s = hctx.jsonrpc#get_string_param "contents" in
+					Some s
+				) None in
+
+				DisplayPosition.display_position#set {
+					pfile = file;
+					pmin = -1;
+					pmax = -1;
+				};
+
+				hctx.com.report_mode <- RMDiagnostics [file_unique, contents];
+				hctx.com.display <- { hctx.com.display with dms_display_file_policy = DFPAlso; dms_per_file = true; dms_populate_cache = !ServerConfig.populate_cache_from_display};
+			end else begin
+				let file_contents = hctx.jsonrpc#get_opt_param (fun () ->
+					hctx.jsonrpc#get_opt_param (fun () -> hctx.jsonrpc#get_array_param "fileContents") []
+				) [] in
+
+				if (List.length file_contents) = 0 then begin
+					hctx.com.report_mode <- RMDiagnostics []
+				end else
+					let file_contents = List.map (fun fc -> match fc with
+						| JObject fl ->
+							let file = hctx.jsonrpc#get_string_field "fileContents" "file" fl in
+							let file = Path.get_full_path file in
+							let file_unique = hctx.com.file_keys#get file in
+							let contents = hctx.jsonrpc#get_opt_param (fun () ->
+								let s = hctx.jsonrpc#get_string_field "fileContents" "contents" fl in
+								Some s
+							) None in
+							(file_unique, contents)
+						| _ -> invalid_arg "fileContents"
+					) file_contents in
+
+					DisplayPosition.display_position#set_files (List.map (fun (k, _) -> k) file_contents);
+					hctx.com.report_mode <- RMDiagnostics file_contents
+			end
+		);
 		"display/implementation", (fun hctx ->
 			hctx.display#set_display_file false true;
 			hctx.display#enable_display (DMImplementation);

src/core/display/displayPosition.ml

@@ -11,6 +11,7 @@ class display_position_container =
 		(** Current display position *)
 		val mutable pos = null_pos
 		val mutable file_key = None
+		val mutable file_keys = []
 		(**
 			Display position value which was set with the latest `display_position#set p` call.
 			Kept even after `display_position#reset` call.
@@ -23,6 +24,10 @@ class display_position_container =
 			pos <- p;
 			last_pos <- p;
 			file_key <- None
+
+		method set_files files =
+			file_keys <- files
+
 		(**
 			Get current display position
 		*)
@@ -43,7 +48,8 @@ class display_position_container =
 		*)
 		method reset =
 			pos <- null_pos;
-			file_key <- None
+			file_key <- None;
+			file_keys <- []
 		(**
 			Check if `p` contains current display position
 		*)
@@ -53,8 +59,15 @@ class display_position_container =
 			Check if a file with `file_key` contains current display position
 		*)
 		method is_in_file file_key =
-			pos.pfile <> "?"
-			&& self#get_file_key = file_key
+			(pos.pfile <> "?" && self#get_file_key = file_key) || self#has_file file_key
+
+		(**
+			This is a hack; currently used by Diagnostics.collect_diagnostics when sending multiple files
+			to run diagnostics on via json rpc
+		*)
+		method has_file file_key =
+			List.mem file_key file_keys
+
 		(**
 			Cut `p` at the position of the latest `display_position#set pos` call.
 		*)

src/typing/typeloadParse.ml

@@ -61,20 +61,26 @@ let parse_file_from_string com file p string =
 let current_stdin = ref None (* TODO: we're supposed to clear this at some point *)
 
 let parse_file com file p =
-	let use_stdin = (Common.defined com Define.DisplayStdin) && DisplayPosition.display_position#is_in_file (com.file_keys#get file) in
-	if use_stdin then
-		let s =
-			match !current_stdin with
-			| Some s ->
-				s
-			| None ->
-				let s = Std.input_all stdin in
-				close_in stdin;
-				current_stdin := Some s;
-				s
-		in
+	let contents = match com.report_mode with
+		| RMDiagnostics files ->
+			(try List.assoc (com.file_keys#get file) files with Not_found -> None)
+		| _ when (Common.defined com Define.DisplayStdin) && DisplayPosition.display_position#is_in_file (com.file_keys#get file) ->
+			Some (match !current_stdin with
+				| Some s ->
+					s
+				| None ->
+					let s = Std.input_all stdin in
+					close_in stdin;
+					current_stdin := Some s;
+					s
+			)
+		| _ -> None
+	in
+
+	match contents with
+	| Some s ->
 		parse_file_from_string com file p s
-	else
+	| _ ->
 		let ch = try open_in_bin file with _ -> raise_typing_error ("Could not open " ^ file) p in
 		Std.finally (fun() -> close_in ch) (parse_file_from_lexbuf com file p) (Sedlexing.Utf8.from_channel ch)
 

std/haxe/display/Display.hx

@@ -25,13 +25,19 @@ package haxe.display;
 import haxe.display.JsonModuleTypes;
 import haxe.display.Position;
 import haxe.display.Protocol;
+import haxe.ds.ReadOnlyArray;
 
 /**
 	Methods of the JSON-RPC-based `--display` protocol in Haxe 4.
 	A lot of the methods are *inspired* by the Language Server Protocol, but there is **no** intention to be directly compatible with it.
 **/
 @:publicFields
 class DisplayMethods {
+	/**
+		TODO documentation
+	**/
+	static inline var Diagnostics = new HaxeRequestMethod<DiagnosticsParams, DiagnosticsResult>("display/diagnostics");
+
 	/**
 		The completion request is sent from the client to Haxe to request code completion.
 		Haxe automatically determines the type of completion to use based on the passed position, see `CompletionResultKind`.
@@ -438,6 +444,17 @@ typedef PatternCompletion<T> = ToplevelCompletion<T> & {
 	var isOutermostPattern:Bool;
 }
 
+typedef DiagnosticsParams = {
+	var ?file:FsPath;
+	var ?contents:String;
+	var ?fileContents:Array<{file:FsPath, ?contents:String}>;
+}
+
+typedef DiagnosticsResult = Response<ReadOnlyArray<{
+	var file:FsPath;
+	var diagnostics:ReadOnlyArray<Diagnostic<Any>>;
+}>>
+
 enum abstract CompletionModeKind<T>(Int) {
 	var Field:CompletionModeKind<FieldCompletionSubject<Dynamic>>;
 	var StructureField;