Completion item filtering

src/compiler/displayOutput.ml

@@ -785,4 +785,4 @@ let handle_syntax_completion com kind p =
 			raise (Completion s)
 		| Some(f,_,jsonrpc) ->
 			let ctx = Genjson.create_context ~jsonrpc:jsonrpc GMFull in
-			f(fields_to_json ctx l kind None)
+			f(fields_to_json ctx l kind None None)

src/compiler/main.ml

@@ -1052,17 +1052,17 @@ with
 	| DisplayException(DisplayPackage pack) ->
 		DisplayPosition.display_position#reset;
 		raise (DisplayOutput.Completion (String.concat "." pack))
-	| DisplayException(DisplayFields Some(fields,cr,_)) ->
+	| DisplayException(DisplayFields Some r) ->
 		DisplayPosition.display_position#reset;
 		let fields = if !measure_times then begin
 			Timer.close_times();
 			(List.map (fun (name,value) ->
 				CompletionItem.make_ci_timer ("@TIME " ^ name) value
-			) (DisplayOutput.get_timer_fields !start_time)) @ fields
+			) (DisplayOutput.get_timer_fields !start_time)) @ r.fitems
 		end else
-			fields
+			r.fitems
 		in
-		let s = match cr with
+		let s = match r.fkind with
 			| CRToplevel _
 			| CRTypeHint
 			| CRExtends
@@ -1117,7 +1117,7 @@ with
 					| [] -> [],""
 				in
 				let kind = CRField ((CompletionItem.make_ci_module path,pos,None,None)) in
-				f (DisplayException.fields_to_json ctx fields kind None);
+				f (DisplayException.fields_to_json ctx fields kind None None);
 			| _ -> raise (DisplayOutput.Completion (DisplayOutput.print_fields fields))
 			end
 		end

src/context/display/displayException.ml

@@ -11,6 +11,13 @@ type hover_result = {
 	hexpected : WithType.t option;
 }
 
+type fields_result = {
+	fitems : CompletionItem.t list;
+	fkind : CompletionResultKind.t;
+	finsert_pos : pos option;
+	fsubject : placed_name option;
+}
+
 type signature_kind =
 	| SKCall
 	| SKArrayAccess
@@ -23,7 +30,7 @@ type kind =
 	| DisplaySignatures of (((tsignature * CompletionType.ct_function) * documentation) list * int * int * signature_kind) option
 	| DisplayHover of hover_result option
 	| DisplayPositions of pos list
-	| DisplayFields of (CompletionItem.t list * CompletionResultKind.t * pos option (* insert pos *)) option
+	| DisplayFields of fields_result option
 	| DisplayPackage of string list
 
 exception DisplayException of kind
@@ -35,17 +42,78 @@ 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_positions pl = raise (DisplayException(DisplayPositions pl))
-let raise_fields ckl cr po = raise (DisplayException(DisplayFields(Some(ckl,cr,po))))
+let raise_fields ckl cr po = raise (DisplayException(DisplayFields(Some({fitems = ckl;fkind = cr;finsert_pos = po;fsubject = None}))))
+let raise_fields2 ckl cr po subject = raise (DisplayException(DisplayFields(Some({fitems = ckl;fkind = cr;finsert_pos = po;fsubject = Some subject}))))
 let raise_package sl = raise (DisplayException(DisplayPackage sl))
 
 (* global state *)
 let last_completion_result = ref (Array.make 0 (CompletionItem.make (ITModule ([],"")) None))
+let last_completion_pos = ref None
+let max_completion_items = ref 0
+
+let filter_somehow ctx items subject kind po =
+	let ret = DynArray.create () in
+	let acc_types = DynArray.create () in
+	let subject = match subject with
+		| None -> ""
+		| Some(subject,_) -> String.lowercase subject
+	in
+	let subject_matches subject s =
+		let rec loop i =
+			if i < String.length subject then begin
+				ignore(String.index_from s i subject.[i]);
+				loop (i + 1)
+			end
+		in
+		try
+			loop 0;
+			true
+		with Not_found ->
+			false
+	in
+	let rec loop items index =
+		match items with
+		| _ when DynArray.length ret > !max_completion_items ->
+			()
+		| item :: items ->
+			let name = String.lowercase (get_filter_name item) in
+			if subject_matches subject name then begin
+				(* Treat types with lowest priority. The assumption is that they are the only kind
+				   which actually causes the limit to be hit, so we show everything else and then
+				   fill in types. *)
+				match item.ci_kind with
+				| ITType _ ->
+					if DynArray.length ret + DynArray.length acc_types < !max_completion_items then
+						DynArray.add acc_types (item,index);
+				| _ ->
+					DynArray.add ret (CompletionItem.to_json ctx (Some index) item);
+			end;
+			loop items (index + 1)
+		| [] ->
+			()
+	in
+	loop items 0;
+	DynArray.iter (fun (item,index) ->
+		if DynArray.length ret < !max_completion_items then
+			DynArray.add ret (CompletionItem.to_json ctx (Some index) item);
+	) acc_types;
+	DynArray.to_list ret,DynArray.length ret = !max_completion_items
 
-let fields_to_json ctx fields kind po =
-	let ja = List.map (CompletionItem.to_json ctx) fields in
+let fields_to_json ctx fields kind po subject =
 	last_completion_result := Array.of_list fields;
+	let needs_filtering = !max_completion_items > 0 && Array.length !last_completion_result > !max_completion_items in
+	let ja,did_filter = if needs_filtering then
+		filter_somehow ctx fields subject kind po
+	else
+		List.mapi (fun i item -> CompletionItem.to_json ctx (Some i) item) fields,false
+ 	in
+	if did_filter then begin match subject with
+		| Some(_,p) -> last_completion_pos := Some p;
+		| None -> last_completion_pos := None
+	end;
 	let fl =
 		("items",jarray ja) ::
+		("isIncomplete",jbool did_filter) ::
 		("mode",CompletionResultKind.to_json ctx kind) ::
 		(match po with None -> [] | Some p -> ["replaceRange",generate_pos_as_range (Parser.cut_pos_at_display p)]) in
 	jobject fl
@@ -107,14 +175,14 @@ let to_json ctx de =
 		jobject [
 			"documentation",jopt jstring (CompletionItem.get_documentation hover.hitem);
 			"range",generate_pos_as_range hover.hpos;
-			"item",CompletionItem.to_json ctx hover.hitem;
+			"item",CompletionItem.to_json ctx None hover.hitem;
 			"expected",expected;
 		]
 	| DisplayPositions pl ->
 		jarray (List.map generate_pos_as_location pl)
 	| DisplayFields None ->
 		jnull
-	| DisplayFields Some(fields,kind,po) ->
-		fields_to_json ctx fields kind po
+	| DisplayFields Some r ->
+		fields_to_json ctx r.fitems r.fkind r.finsert_pos r.fsubject
 	| DisplayPackage pack ->
 		jarray (List.map jstring pack)

src/context/display/displayJson.ml

@@ -87,6 +87,7 @@ let handler =
 	let l = [
 		"initialize", (fun hctx ->
 			supports_resolve := hctx.jsonrpc#get_opt_param (fun () -> hctx.jsonrpc#get_bool_param "supportsResolve") false;
+			DisplayException.max_completion_items := hctx.jsonrpc#get_opt_param (fun () -> hctx.jsonrpc#get_int_param "maxCompletionItems") 0;
 			let exclude = hctx.jsonrpc#get_opt_param (fun () -> hctx.jsonrpc#get_array_param "exclude") [] in
 			DisplayToplevel.exclude := List.map (fun e -> match e with JString s -> s | _ -> assert false) exclude;
 			let methods = Hashtbl.fold (fun k _ acc -> (jstring k) :: acc) h [] in
@@ -111,7 +112,7 @@ let handler =
 			begin try
 				let item = (!DisplayException.last_completion_result).(i) in
 				let ctx = Genjson.create_context GMFull in
-				hctx.send_result (jobject ["item",CompletionItem.to_json ctx item])
+				hctx.send_result (jobject ["item",CompletionItem.to_json ctx None item])
 			with Invalid_argument _ ->
 				hctx.send_error [jstring (Printf.sprintf "Invalid index: %i" i)]
 			end

src/context/display/displayToplevel.ml

@@ -424,6 +424,15 @@ let collect ctx tk with_type =
 	t();
 	l
 
+let collect_and_raise ctx tk with_type cr subject pinsert =
+	let fields = match !DisplayException.last_completion_pos with
+	| Some p' when (pos subject).pmin = p'.pmin ->
+		Array.to_list (!DisplayException.last_completion_result)
+	| _ ->
+		collect ctx tk with_type
+	in
+	DisplayException.raise_fields2 fields cr pinsert subject
+
 let handle_unresolved_identifier ctx i p only_types =
 	let l = collect ctx (if only_types then TKType else TKExpr p) NoValue in
 	let cl = List.map (fun it ->

src/core/display/completionItem.ml

@@ -567,13 +567,28 @@ let get_name item = match item.ci_kind with
 
 let get_type item = item.ci_type
 
+let get_filter_name item = match item.ci_kind with
+	| ITLocal v -> v.v_name
+	| ITClassField(cf) | ITEnumAbstractField(_,cf) -> cf.field.cf_name
+	| ITEnumField ef -> ef.efield.ef_name
+	| ITType(cm,_) -> s_type_path (cm.pack,cm.name)
+	| ITPackage(path,_) -> s_type_path path
+	| ITModule path -> s_type_path path
+	| ITLiteral s -> s
+	| ITTimer(s,_) -> s
+	| ITMetadata meta -> Meta.to_string meta
+	| ITKeyword kwd -> s_keyword kwd
+	| ITAnonymous _ -> ""
+	| ITExpression _ -> ""
+	| ITTypeParameter c -> snd c.cl_path
+
 let get_documentation item = match item.ci_kind with
 	| ITClassField cf | ITEnumAbstractField(_,cf) -> cf.field.cf_doc
 	| ITEnumField ef -> ef.efield.ef_doc
 	| ITType(mt,_) -> mt.doc
 	| _ -> None
 
-let to_json ctx item =
+let to_json ctx index item =
 	let open ClassFieldOrigin in
 	let kind,data = match item.ci_kind with
 		| ITLocal v -> "Local",generate_tvar ctx v
@@ -687,8 +702,17 @@ let to_json ctx item =
 			| _ -> assert false
 			end
 	in
+	let jindex = match index with
+		| None -> []
+		| Some index -> ["index",jint index]
+	in
 	jobject (
 		("kind",jstring kind) ::
 		("args",data) ::
-		(match item.ci_type with None -> [] | Some t -> ["type",CompletionType.to_json ctx (snd t)])
+		(match item.ci_type with
+			| None ->
+				jindex
+			| Some t ->
+				("type",CompletionType.to_json ctx (snd t)) :: jindex
+		)
 	)

src/core/displayTypes.ml

@@ -125,7 +125,7 @@ module CompletionResultKind = struct
 							None
 				in
 				let fields =
-					("item",CompletionItem.to_json ctx item) ::
+					("item",CompletionItem.to_json ctx None item) ::
 					("range",generate_pos_as_range p) ::
 					("iterator", match iterator with
 						| None -> jnull

src/typing/typeload.ml

@@ -355,7 +355,7 @@ and load_instance ctx ?(allow_display=false) (t,pn) allow_no_params =
 		t
 	with Error (Module_not_found path,_) when (ctx.com.display.dms_kind = DMDefault) && DisplayPosition.display_position#enclosed_in pn ->
 		let s = s_type_path path in
-		raise_fields (DisplayToplevel.collect ctx TKType NoValue) CRTypeHint (Some {pn with pmin = pn.pmax - String.length s;});
+		DisplayToplevel.collect_and_raise ctx TKType NoValue CRTypeHint (s,pn) (Some {pn with pmin = pn.pmax - String.length s;})
 
 (*
 	build an instance from a complex type
@@ -370,12 +370,12 @@ 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)
-			with DisplayException(DisplayFields Some(l,CRTypeHint,p)) ->
+			with DisplayException(DisplayFields Some({fkind = CRTypeHint} as r)) ->
 				let l = List.filter (fun item -> match item.ci_kind with
 					| ITType({kind = Struct},_) -> true
 					| _ -> false
-				) l in
-				raise_fields l (CRStructExtension true) p
+				) r.fitems in
+				raise_fields l (CRStructExtension true) r.finsert_pos
 		) tl in
 		let tr = ref None in
 		let t = TMono tr in
@@ -412,12 +412,12 @@ 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
-				with DisplayException(DisplayFields Some(l,CRTypeHint,p)) ->
+				with DisplayException(DisplayFields Some({fkind = CRTypeHint} as r)) ->
 					let l = List.filter (fun item -> match item.ci_kind with
 						| ITType({kind = Struct},_) -> true
 						| _ -> false
-					) l in
-					raise_fields l (CRStructExtension false) p
+					) r.fitems in
+					raise_fields l (CRStructExtension false) r.finsert_pos
 			) tl in
 			let tr = ref None in
 			let t = TMono tr in
@@ -845,9 +845,8 @@ let handle_path_display ctx path p =
 		DisplayEmitter.display_field ctx origin CFSStatic cf p
 	in
 	match ImportHandling.convert_import_to_something_usable DisplayPosition.display_position#get path,ctx.com.display.dms_kind with
-		| (IDKPackage [_],p),DMDefault ->
-			let fields = DisplayToplevel.collect ctx TKType WithType.no_value in
-			raise_fields fields CRImport (Some p)
+		| (IDKPackage [s],p),DMDefault ->
+			DisplayToplevel.collect_and_raise ctx TKType WithType.no_value CRImport (s,p) (Some p)
 		| (IDKPackage sl,p),DMDefault ->
 			let sl = match List.rev sl with
 				| s :: sl -> List.rev sl

src/typing/typeloadCheck.ml

@@ -471,18 +471,18 @@ module Inheritance = struct
 			try
 				let t = try
 					Typeload.load_instance ~allow_display:true ctx (ct,p) false
-				with DisplayException(DisplayFields Some(l,CRTypeHint,p)) ->
+				with DisplayException(DisplayFields Some({fkind = CRTypeHint} as r)) ->
 					(* We don't allow `implements` on interfaces. Just raise fields completion with no fields. *)
-					if not is_extends && c.cl_interface then raise_fields [] CRImplements p;
+					if not is_extends && c.cl_interface then raise_fields [] CRImplements r.finsert_pos;
 					let l = List.filter (fun item -> match item.ci_kind with
 						| ITType({kind = Interface} as cm,_) -> (not is_extends || c.cl_interface) && CompletionModuleType.get_path cm <> c.cl_path
 						| ITType({kind = Class} as cm,_) ->
 							is_extends && not c.cl_interface && CompletionModuleType.get_path cm <> c.cl_path &&
 							(not cm.is_final || Meta.has Meta.Hack c.cl_meta) &&
 							(not (is_basic_class_path (cm.pack,cm.name)) || (c.cl_extern && cm.is_extern))
 						| _ -> false
-					) l in
-					raise_fields l (if is_extends then CRExtends else CRImplements) p
+					) r.fitems in
+					raise_fields l (if is_extends then CRExtends else CRImplements) r.finsert_pos
 				in
 				Some (check_herit t is_extends p)
 			with Error(Module_not_found(([],name)),p) when ctx.com.display.dms_kind <> DMNone ->

src/typing/typer.ml

@@ -1352,10 +1352,11 @@ and handle_efield ctx e p mode =
 								raise (Error (Module_not_found (List.rev !path,name),p))
 							with
 								Not_found ->
+									let sl = List.map (fun (n,_,_) -> n) (List.rev acc) in
 									(* if there was no module name part, last guess is that we're trying to get package completion *)
 									if ctx.in_display then begin
-										if ctx.com.json_out = None then raise (Parser.TypePath (List.map (fun (n,_,_) -> n) (List.rev acc),None,false,p))
-										else raise_fields (DisplayToplevel.collect ctx TKType WithType.no_value) (CRToplevel None) (Some p0);
+										if ctx.com.json_out = None then raise (Parser.TypePath (sl,None,false,p))
+										else DisplayToplevel.collect_and_raise ctx TKType WithType.no_value (CRToplevel None) (String.concat "." sl,p0) (Some p0)
 									end;
 									raise e)
 		in