[display] clean up exception handling again and support textDocument/signatureHelp

src/compiler/displayOutput.ml

@@ -825,29 +825,4 @@ let find_doc t =
 		| _ ->
 			None
 	in
-	doc
-
-open Genjson
-
-let print_positions com pl = match com.json_out with
-	| None -> print_positions pl
-	| Some(f,_) -> f (JArray (List.map generate_pos_as_location pl))
-
-let print_type com t p doc = match com.json_out with
-	| None -> print_type t p doc
-	| Some(f,_) -> f (JObject [
-		"documentation",jopt jstring doc;
-		"range",generate_pos_as_range p;
-		"type",generate_type (create_context ()) t;
-	])
-
-let print_fields com fields is_toplevel = match com.json_out with
-	| None ->
-		if is_toplevel then print_toplevel fields else print_fields fields
-	| Some(f,_) ->
-		let j = List.map (CompletionKind.to_json (Genjson.create_context ())) fields in
-		f (jarray j)
-
-let print_package com pack = match com.json_out with
-	| None -> String.concat "." pack
-	| Some(f,_) -> f (JArray (List.map jstring pack))
+	doc

src/compiler/main.ml

@@ -944,29 +944,33 @@ with
 		error ctx ("Error: " ^ msg) null_pos
 	| HelpMessage msg ->
 		message ctx (CMInfo(msg,null_pos))
+	| DisplayException(DisplayType _ | DisplayPosition _ | DisplayFields _ | DisplayPackage _  | DisplaySignatures _ as de) when ctx.com.json_out <> None ->
+		begin match ctx.com.json_out with
+		| Some (f,_) -> raise (DisplayOutput.Completion (f (Display.DisplayException.to_json de)))
+		| _ -> assert false
+		end
 	| DisplayException(DisplayPackage pack) ->
-		raise (DisplayOutput.Completion (DisplayOutput.print_package ctx.com pack))
+		raise (DisplayOutput.Completion (String.concat "." pack))
 	| DisplayException(DisplayFields(fields,is_toplevel)) ->
-		let fields = match ctx.com.json_out with
-			| None when !measure_times ->
-				Timer.close_times();
-				(List.map (fun (name,value) ->
-					DisplayTypes.CompletionKind.ITTimer("@TIME " ^ name,value)
-				) (DisplayOutput.get_timer_fields !start_time)) @ fields
-			| _ ->
-				fields
+		let fields = if !measure_times then begin
+			Timer.close_times();
+			(List.map (fun (name,value) ->
+				DisplayTypes.CompletionKind.ITTimer("@TIME " ^ name,value)
+			) (DisplayOutput.get_timer_fields !start_time)) @ fields
+		end else
+			fields
 		in
-		raise (DisplayOutput.Completion (DisplayOutput.print_fields ctx.com fields is_toplevel))
+		raise (DisplayOutput.Completion (if is_toplevel then DisplayOutput.print_toplevel fields else DisplayOutput.print_fields fields))
 	| DisplayException(DisplayType (t,p,doc)) ->
 		let doc = match doc with Some _ -> doc | None -> DisplayOutput.find_doc t in
-		raise (DisplayOutput.Completion (DisplayOutput.print_type ctx.com t p doc))
-	| DisplayException(DisplaySignatures(signatures,display_arg)) ->
+		raise (DisplayOutput.Completion (DisplayOutput.print_type t p doc))
+	| DisplayException(DisplaySignatures(signatures,display_arg,_)) ->
 		if ctx.com.display.dms_kind = DMSignature then
 			raise (DisplayOutput.Completion (DisplayOutput.print_signature signatures display_arg))
 		else
 			raise (DisplayOutput.Completion (DisplayOutput.print_signatures signatures))
 	| DisplayException(DisplayPosition pl) ->
-		raise (DisplayOutput.Completion (DisplayOutput.print_positions ctx.com pl))
+		raise (DisplayOutput.Completion (DisplayOutput.print_positions pl))
 	| Parser.TypePath (p,c,is_import) ->
 		let fields =
 			try begin match c with
@@ -978,7 +982,7 @@ with
 				error ctx msg p;
 				None
 		in
-		Option.may (fun fields -> raise (DisplayOutput.Completion (DisplayOutput.print_fields ctx.com fields false))) fields
+		Option.may (fun fields -> raise (DisplayOutput.Completion (DisplayOutput.print_fields fields))) fields
 	| DisplayException(ModuleSymbols s | Diagnostics s | Statistics s | Metadata s) ->
 		raise (DisplayOutput.Completion s)
 	| EvalExceptions.Sys_exit i | Hlinterp.Sys_exit i ->

src/context/display.ml

@@ -5,6 +5,7 @@ open DisplayTypes.CompletionKind
 open Type
 open Typecore
 open Globals
+open Genjson
 
 let reference_position = ref null_pos
 
@@ -14,7 +15,7 @@ module DisplayException = struct
 		| Statistics of string
 		| ModuleSymbols of string
 		| Metadata of string
-		| DisplaySignatures of (tsignature * documentation) list * int
+		| DisplaySignatures of (tsignature * documentation) list * int * int
 		| DisplayType of t * pos * string option
 		| DisplayPosition of pos list
 		| DisplayFields of DisplayTypes.CompletionKind.t list * bool (* toplevel? *)
@@ -26,11 +27,42 @@ module DisplayException = struct
 	let raise_statistics s = raise (DisplayException(Statistics s))
 	let raise_module_symbols s = raise (DisplayException(ModuleSymbols s))
 	let raise_metadata s = raise (DisplayException(Metadata s))
-	let raise_signatures l i = raise (DisplayException(DisplaySignatures(l,i)))
+	let raise_signatures l isig iarg = raise (DisplayException(DisplaySignatures(l,isig,iarg)))
 	let raise_type t p so = raise (DisplayException(DisplayType(t,p,so)))
 	let raise_position pl = raise (DisplayException(DisplayPosition pl))
 	let raise_fields ckl b = raise (DisplayException(DisplayFields(ckl,b)))
 	let raise_package sl = raise (DisplayException(DisplayPackage sl))
+
+	let to_json de = match de with
+		| Diagnostics _
+		| Statistics _
+		| ModuleSymbols _
+		| Metadata _ -> assert false
+		| DisplaySignatures(sigs,isig,iarg) ->
+			let ctx = Genjson.create_context () in
+			let fsig ((tl,tr),doc) =
+				let fl = generate_function_signature ctx tl tr in
+				let fl = (match doc with None -> fl | Some s -> ("documentation",jstring s) :: fl) in
+				jobject fl
+			in
+			jobject [
+				"activeSignature",jint isig;
+				"activeParameter",jint iarg;
+				"signatures",jlist fsig sigs;
+			]
+		| DisplayType(t,p,doc) ->
+			jobject [
+				"documentation",jopt jstring doc;
+				"range",generate_pos_as_range p;
+				"type",generate_type (create_context ()) t;
+			]
+		| DisplayPosition pl ->
+			jarray (List.map generate_pos_as_location pl)
+		| DisplayFields(fields,_) ->
+			let j = List.map (DisplayTypes.CompletionKind.to_json (Genjson.create_context ())) fields in
+			jarray j
+		| DisplayPackage pack ->
+			jarray (List.map jstring pack)
 end
 
 open DisplayException

src/context/displayJson.ml

@@ -21,6 +21,7 @@ let get_capabilities () =
 		"hoverProvider",JBool true;
 		"completionProvider",JBool true;
 		"packageProvider",JBool true;
+		"signatureHelpProvider",JBool true;
 	]
 
 (* Generate the JSON of our times. *)
@@ -134,6 +135,9 @@ let parse_input com input report_times =
 			| "textDocument/package" ->
 				read_display_file false false false;
 				enable_display DMPackage;
+			| "textDocument/signatureHelp" ->
+				read_display_file (get_bool_param "wasAutoTriggered") true false;
+				enable_display DMSignature
 			| _ -> raise_method_not_found id name
 		end;
 		com.json_out <- Some(f_result,f_error)

src/core/json/genjson.ml

@@ -147,18 +147,7 @@ let rec generate_type ctx t =
 		| TType(td,tl) -> "TType",Some (generate_path_with_params ctx td.t_path tl)
 		| TAbstract(a,tl) -> "TAbstract",Some (generate_path_with_params ctx a.a_path tl)
 		| TAnon an -> "TAnonymous", Some(generate_anon an)
-		| TFun(tl,tr) -> "TFun", Some (generate_function_signature tl tr)
-	and generate_function_argument (name,opt,t) =
-		jobject [
-			"name",jstring name;
-			"opt",jbool opt;
-			"t",generate_type ctx t;
-		]
-	and generate_function_signature tl tr =
-		jobject [
-			"args",jlist generate_function_argument tl;
-			"ret",generate_type ctx tr;
-		]
+		| TFun(tl,tr) -> "TFun", Some (jobject (generate_function_signature ctx tl tr))
 	and generate_anon an =
 		let generate_anon_fields () =
 			let fields = PMap.fold (fun cf acc -> generate_class_field ctx cf :: acc) an.a_fields [] in
@@ -184,6 +173,19 @@ let rec generate_type ctx t =
 	let name,args = loop t in
 	generate_adt ctx None name args
 
+and generate_function_argument ctx (name,opt,t) =
+	jobject [
+		"name",jstring name;
+		"opt",jbool opt;
+		"t",generate_type ctx t;
+	]
+
+and generate_function_signature ctx tl tr =
+	[
+		"args",jlist (generate_function_argument ctx) tl;
+		"ret",generate_type ctx tr;
+	]
+
 and generate_types ctx tl =
 	jlist (generate_type ctx) tl
 

src/typing/typerDisplay.ml

@@ -21,7 +21,7 @@ let rec handle_display ctx e_ast dk with_type =
 		let arg = ["expression",false,mono] in
 		begin match ctx.com.display.dms_kind with
 		| DMSignature ->
-			raise_signatures [((arg,mono),doc)] 0
+			raise_signatures [((arg,mono),doc)] 0 0
 		| _ ->
 			raise_type (TFun(arg,mono)) (pos e_ast) doc
 		end
@@ -31,7 +31,7 @@ let rec handle_display ctx e_ast dk with_type =
 		let ret = ctx.com.basic.tvoid in
 		begin match ctx.com.display.dms_kind with
 		| DMSignature ->
-			raise_signatures [((arg,ret),doc)] 0
+			raise_signatures [((arg,ret),doc)] 0 0
 		| _ ->
 			raise_type (TFun(arg,ret)) (pos e_ast) doc
 		end
@@ -93,7 +93,7 @@ and handle_signature_display ctx e_ast with_type =
 				acc
 		in
 		let overloads = match loop [] tl with [] -> tl | tl -> tl in
-		raise_signatures overloads display_arg
+		raise_signatures overloads display_arg 0 (* ? *)
 	in
 	let find_constructor_types t = match follow t with
 		| TInst (c,tl) | TAbstract({a_impl = Some c},tl) ->