restructure display exceptions a bit

src/compiler/compiler.ml

@@ -258,12 +258,8 @@ let handle_display ctx tctx display_file_dot_path =
 			ignore(load_display_module_in_macro tctx display_file_dot_path true);
 		let no_completion_point_found = "No completion point was found" in
 		match com.json_out with
-		| Some _ -> (match ctx.com.display.dms_kind with
-			| DMDefault -> raise (DisplayException(DisplayFields None))
-			| DMSignature -> raise (DisplayException(DisplaySignatures None))
-			| DMHover -> raise (DisplayException(DisplayHover None))
-			| DMDefinition | DMTypeDefinition -> raise_positions []
-			| _ -> failwith no_completion_point_found)
+		| Some _ ->
+			raise (DisplayException DisplayNoResult)
 		| None ->
 			failwith no_completion_point_found;
 	end
@@ -562,6 +558,76 @@ let finalize ctx =
 	) ctx.on_exit;
 	ctx.comm.flush ctx
 
+open DisplayTypes
+
+let handle_display_exception_old ctx dex = match dex with
+	| DisplayPackage pack ->
+		DisplayPosition.display_position#reset;
+		raise (DisplayOutput.Completion (String.concat "." pack))
+	| DisplayFields r ->
+		DisplayPosition.display_position#reset;
+		let fields = if !Timer.measure_times then begin
+			Timer.close_times();
+			(List.map (fun (name,value) ->
+				CompletionItem.make_ci_timer ("@TIME " ^ name) value
+			) (DisplayOutput.get_timer_fields !Helper.start_time)) @ r.fitems
+		end else
+			r.fitems
+		in
+		let s = match r.fkind with
+			| CRToplevel _
+			| CRTypeHint
+			| CRExtends
+			| CRImplements
+			| CRStructExtension _
+			| CRImport
+			| CRUsing
+			| CRNew
+			| CRPattern _
+			| CRTypeRelation
+			| CRTypeDecl ->
+				DisplayOutput.print_toplevel fields
+			| CRField _
+			| CRStructureField
+			| CRMetadata
+			| CROverride ->
+				DisplayOutput.print_fields fields
+		in
+		raise (DisplayOutput.Completion s)
+	| DisplayHover ({hitem = {CompletionItem.ci_type = Some (t,_)}} as hover) ->
+		DisplayPosition.display_position#reset;
+		let doc = CompletionItem.get_documentation hover.hitem in
+		raise (DisplayOutput.Completion (DisplayOutput.print_type t hover.hpos doc))
+	| DisplaySignatures (signatures,_,display_arg,_) ->
+		DisplayPosition.display_position#reset;
+		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))
+	| DisplayPositions pl ->
+		DisplayPosition.display_position#reset;
+		raise (DisplayOutput.Completion (DisplayOutput.print_positions pl))
+	| ModuleSymbols s | Metadata s ->
+		DisplayPosition.display_position#reset;
+		raise (DisplayOutput.Completion s)
+	| DisplayHover _ | DisplayNoResult ->
+		raise (DisplayOutput.Completion "")
+
+let handle_display_exception_json ctx dex api =
+	match dex with
+	| DisplayHover _ | DisplayPositions _ | DisplayFields _ | DisplayPackage _  | DisplaySignatures _ ->
+		DisplayPosition.display_position#reset;
+		let ctx = DisplayJson.create_json_context api.jsonrpc (match dex with DisplayFields _ -> true | _ -> false) in
+		api.send_result (DisplayException.to_json ctx dex)
+	| _ ->
+		handle_display_exception_old ctx dex
+
+let handle_display_exception ctx dex = match ctx.com.json_out with
+	| Some api ->
+		handle_display_exception_json ctx dex api
+	| None ->
+		handle_display_exception_old ctx dex
+
 let compile_safe ctx f =
 	let com = ctx.com in
 try
@@ -595,15 +661,6 @@ with
 		error ctx ("Error: " ^ msg) null_pos
 	| Helper.HelpMessage msg ->
 		com.info msg null_pos
-	| DisplayException(DisplayHover _ | DisplayPositions _ | DisplayFields _ | DisplayPackage _  | DisplaySignatures _ as de) when ctx.com.json_out <> None ->
-		begin
-			DisplayPosition.display_position#reset;
-			match ctx.com.json_out with
-			| Some api ->
-				let ctx = DisplayJson.create_json_context api.jsonrpc (match de with DisplayFields _ -> true | _ -> false) in
-				api.send_result (DisplayException.to_json ctx de)
-			| _ -> die "" __LOC__
-		end
 	(* | Parser.TypePath (_,_,_,p) when ctx.com.json_out <> None ->
 		begin match com.json_out with
 		| Some (f,_) ->
@@ -613,52 +670,6 @@ with
 			f (DisplayException.fields_to_json jctx fields CRImport (Some (Parser.cut_pos_at_display p)) false)
 		| _ -> die "" __LOC__
 		end *)
-	| DisplayException(DisplayPackage pack) ->
-		DisplayPosition.display_position#reset;
-		raise (DisplayOutput.Completion (String.concat "." pack))
-	| DisplayException(DisplayFields Some r) ->
-		DisplayPosition.display_position#reset;
-		let fields = if !Timer.measure_times then begin
-			Timer.close_times();
-			(List.map (fun (name,value) ->
-				CompletionItem.make_ci_timer ("@TIME " ^ name) value
-			) (DisplayOutput.get_timer_fields !Helper.start_time)) @ r.fitems
-		end else
-			r.fitems
-		in
-		let s = match r.fkind with
-			| CRToplevel _
-			| CRTypeHint
-			| CRExtends
-			| CRImplements
-			| CRStructExtension _
-			| CRImport
-			| CRUsing
-			| CRNew
-			| CRPattern _
-			| CRTypeRelation
-			| CRTypeDecl ->
-				DisplayOutput.print_toplevel fields
-			| CRField _
-			| CRStructureField
-			| CRMetadata
-			| CROverride ->
-				DisplayOutput.print_fields fields
-		in
-		raise (DisplayOutput.Completion s)
-	| DisplayException(DisplayHover Some ({hitem = {CompletionItem.ci_type = Some (t,_)}} as hover)) ->
-		DisplayPosition.display_position#reset;
-		let doc = CompletionItem.get_documentation hover.hitem in
-		raise (DisplayOutput.Completion (DisplayOutput.print_type t hover.hpos doc))
-	| DisplayException(DisplaySignatures Some (signatures,_,display_arg,_)) ->
-		DisplayPosition.display_position#reset;
-		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(DisplayPositions pl) ->
-		DisplayPosition.display_position#reset;
-		raise (DisplayOutput.Completion (DisplayOutput.print_positions pl))
 	| Parser.TypePath (p,c,is_import,pos) ->
 		let fields =
 			try begin match c with
@@ -691,15 +702,12 @@ with
 	| Parser.SyntaxCompletion(kind,subj) ->
 		DisplayOutput.handle_syntax_completion com kind subj;
 		error ctx ("Error: No completion point was found") null_pos
-	| DisplayException(ModuleSymbols s | Metadata s) ->
-		DisplayPosition.display_position#reset;
-		raise (DisplayOutput.Completion s)
 	| EvalExceptions.Sys_exit i | Hlinterp.Sys_exit i ->
 		finalize ctx;
 		if !Timer.measure_times then Timer.report_times prerr_endline;
 		exit i
-	| DisplayOutput.Completion _ as exc ->
-		raise exc
+	| DisplayException dex ->
+		handle_display_exception ctx dex
 	| Out_of_memory as exc ->
 		raise exc
 	| e when (try Sys.getenv "OCAMLRUNPARAM" <> "b" with _ -> true) && not Helper.is_debug_run ->

src/context/display/displayException.ml

@@ -9,10 +9,10 @@ exception DisplayException of display_exception_kind
 
 let raise_module_symbols s = raise (DisplayException(ModuleSymbols s))
 let raise_metadata s = raise (DisplayException(Metadata s))
-let raise_signatures l isig iarg kind = raise (DisplayException(DisplaySignatures(Some(l,isig,iarg,kind))))
-let raise_hover item expected p = raise (DisplayException(DisplayHover(Some {hitem = item;hpos = p;hexpected = expected})))
+let raise_signatures l isig iarg kind = raise (DisplayException(DisplaySignatures((l,isig,iarg,kind))))
+let raise_hover item expected p = raise (DisplayException(DisplayHover({hitem = item;hpos = p;hexpected = expected})))
 let raise_positions pl = raise (DisplayException(DisplayPositions pl))
-let raise_fields ckl cr subj = raise (DisplayException(DisplayFields(Some({fitems = ckl;fkind = cr;fsubject = subj}))))
+let raise_fields ckl cr subj = raise (DisplayException(DisplayFields({fitems = ckl;fkind = cr;fsubject = subj})))
 let raise_package sl = raise (DisplayException(DisplayPackage sl))
 
 (* global state *)
@@ -159,9 +159,7 @@ let to_json ctx de =
 	match de with
 	| ModuleSymbols _
 	| Metadata _ -> die "" __LOC__
-	| DisplaySignatures None ->
-		jnull
-	| DisplaySignatures Some(sigs,isig,iarg,kind) ->
+	| DisplaySignatures(sigs,isig,iarg,kind) ->
 		(* We always want full info for signatures *)
 		let ctx = Genjson.create_context GMFull in
 		let fsig ((_,signature),doc) =
@@ -179,9 +177,7 @@ let to_json ctx de =
 			"signatures",jlist fsig sigs;
 			"kind",jint sigkind;
 		]
-	| DisplayHover None ->
-		jnull
-	| DisplayHover (Some hover) ->
+	| DisplayHover hover ->
 		let named_source_kind = function
 			| WithType.FunctionArgument name -> (0, name)
 			| WithType.StructureField name -> (1, name)
@@ -220,9 +216,9 @@ let to_json ctx de =
 		]
 	| DisplayPositions pl ->
 		jarray (List.map generate_pos_as_location pl)
-	| DisplayFields None ->
-		jnull
-	| DisplayFields Some r ->
+	| DisplayFields r ->
 		fields_to_json ctx r.fitems r.fkind r.fsubject
 	| DisplayPackage pack ->
-		jarray (List.map jstring pack)
+		jarray (List.map jstring pack)
+	| DisplayNoResult ->
+		jnull

src/core/displayTypes.ml

@@ -375,8 +375,9 @@ type diagnostics_context = {
 type display_exception_kind =
 	| ModuleSymbols of string
 	| Metadata of string
-	| DisplaySignatures of (((tsignature * CompletionItem.CompletionType.ct_function) * documentation) list * int * int * signature_kind) option
-	| DisplayHover of hover_result option
+	| DisplaySignatures of (((tsignature * CompletionItem.CompletionType.ct_function) * documentation) list * int * int * signature_kind)
+	| DisplayHover of hover_result
 	| DisplayPositions of pos list
-	| DisplayFields of fields_result option
-	| DisplayPackage of string list
+	| DisplayFields of fields_result
+	| DisplayPackage of string list
+	| DisplayNoResult

src/typing/callUnification.ml

@@ -256,7 +256,7 @@ let unify_field_call ctx fa el_typed el p inline =
 			| Some s -> new Javadoc.javadoc s
 		in
 		match de with
-		| DisplayHover (Some hover) ->
+		| DisplayHover hover ->
 			begin match hover.hexpected with
 			| Some (WithType(t,Some si)) ->
 				let si = match si with

src/typing/typeload.ml

@@ -454,7 +454,7 @@ and load_complex_type' ctx allow_display (t,p) =
 		let tl = List.map (fun (t,pn) ->
 			try
 				(load_complex_type ctx allow_display (t,pn),pn)
-			with DisplayException(DisplayFields Some({fkind = CRTypeHint} as r)) ->
+			with DisplayException(DisplayFields ({fkind = CRTypeHint} as r)) ->
 				let l = List.filter (fun item -> match item.ci_kind with
 					| ITType({kind = Struct},_) -> true
 					| _ -> false
@@ -496,7 +496,7 @@ and load_complex_type' ctx allow_display (t,p) =
 			let il = List.map (fun (t,pn) ->
 				try
 					(load_instance ctx ~allow_display (t,pn) false,pn)
-				with DisplayException(DisplayFields Some({fkind = CRTypeHint} as r)) ->
+				with DisplayException(DisplayFields ({fkind = CRTypeHint} as r)) ->
 					let l = List.filter (fun item -> match item.ci_kind with
 						| ITType({kind = Struct},_) -> true
 						| _ -> false

src/typing/typeloadCheck.ml

@@ -600,7 +600,7 @@ module Inheritance = struct
 			try
 				let t = try
 					Typeload.load_instance ~allow_display:true ctx (ct,p) false
-				with DisplayException(DisplayFields Some({fkind = CRTypeHint} as r)) ->
+				with DisplayException(DisplayFields ({fkind = CRTypeHint} as r)) ->
 					(* We don't allow `implements` on interfaces. Just raise fields completion with no fields. *)
 					if not is_extends && (has_class_flag c CInterface) then raise_fields [] CRImplements r.fsubject;
 					let l = List.filter (fun item -> match item.ci_kind with

src/typing/typeloadParse.ml

@@ -251,7 +251,7 @@ module PdiHandler = struct
 					raise DisplayInMacroBlock;
 				begin match com.display.dms_kind with
 				| DMHover ->
-					raise (DisplayException.DisplayException(DisplayHover None))
+					raise (DisplayException.DisplayException(DisplayNoResult))
 				| _ ->
 					()
 				end;

src/typing/typerDisplay.ml

@@ -546,7 +546,7 @@ let handle_display ctx e_ast dk mode with_type =
 			raise err
 		end else
 			raise_toplevel ctx dk with_type (s_type_path path,p)
-	| DisplayException(DisplayFields Some({fkind = CRTypeHint} as r)) when (match fst e_ast with ENew _ -> true | _ -> false) ->
+	| DisplayException(DisplayFields ({fkind = CRTypeHint} as r)) when (match fst e_ast with ENew _ -> true | _ -> false) ->
 		let timer = Timer.timer ["display";"toplevel";"filter ctors"] in
 		ctx.pass <- PBuildClass;
 		let l = List.filter (fun item ->
@@ -712,7 +712,7 @@ let handle_edisplay ctx e dk mode with_type =
 	| DKPattern outermost,DMDefault ->
 		begin try
 			handle_display ctx e dk with_type
-		with DisplayException(DisplayFields Some({fkind = CRToplevel _} as r)) ->
+		with DisplayException(DisplayFields ({fkind = CRToplevel _} as r)) ->
 			raise_fields r.fitems (CRPattern ((get_expected_type ctx with_type),outermost)) r.fsubject
 		end
 	| _ -> handle_display ctx e dk with_type