Skip to content

Commit 45a5387

Browse files
committed
more unwinding of unecessary variant members for completion type
1 parent 19e0787 commit 45a5387

File tree

4 files changed

+112
-84
lines changed

4 files changed

+112
-84
lines changed

analysis/src/CompletionBackEnd.ml

Lines changed: 56 additions & 44 deletions
Original file line numberDiff line numberDiff line change
@@ -584,15 +584,17 @@ let completionsGetTypeEnv = function
584584
| _ -> None
585585

586586
let completionsGetCompletionType ~full = function
587-
| {Completion.kind = Value typ; env} :: _ -> Some (TypeExpr typ, env)
588-
| {Completion.kind = ObjLabel typ; env} :: _ -> Some (TypeExpr typ, env)
589-
| {Completion.kind = Field ({typ}, _); env} :: _ -> Some (TypeExpr typ, env)
587+
| {Completion.kind = Value typ; env} :: _
588+
| {Completion.kind = ObjLabel typ; env} :: _
589+
| {Completion.kind = Field ({typ}, _); env} :: _ ->
590+
typ
591+
|> TypeUtils.extractType ~env ~package:full.package
592+
|> Option.map (fun typ -> (typ, env))
590593
| {Completion.kind = Type typ; env} :: _ -> (
591594
match TypeUtils.extractTypeFromResolvedType typ ~env ~full with
592595
| None -> None
593-
| Some extractedType -> Some (ExtractedType extractedType, env))
594-
| {Completion.kind = ExtractedType typ; env} :: _ ->
595-
Some (ExtractedType typ, env)
596+
| Some extractedType -> Some (extractedType, env))
597+
| {Completion.kind = ExtractedType typ; env} :: _ -> Some (typ, env)
596598
| _ -> None
597599

598600
let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
@@ -1007,17 +1009,16 @@ let printConstructorArgs argsLen ~asSnippet =
10071009

10081010
type completionMode = Pattern | Expression
10091011

1010-
let rec completeTypedValue (t : SharedTypes.completionType) ~env ~full ~prefix
1012+
let rec completeTypedValue (t : SharedTypes.completionType) ~full ~prefix
10111013
~completionContext ~mode =
1012-
let extractedType = t |> TypeUtils.extractTypeFromCompletionType ~env ~full in
1013-
match extractedType with
1014-
| Some (Tbool env) ->
1014+
match t with
1015+
| Tbool env ->
10151016
[
10161017
Completion.create "true" ~kind:(Label "bool") ~env;
10171018
Completion.create "false" ~kind:(Label "bool") ~env;
10181019
]
10191020
|> filterItems ~prefix
1020-
| Some (Tvariant {env; constructors; variantDecl; variantName}) ->
1021+
| Tvariant {env; constructors; variantDecl; variantName} ->
10211022
constructors
10221023
|> List.map (fun (constructor : Constructor.t) ->
10231024
let numArgs =
@@ -1037,7 +1038,7 @@ let rec completeTypedValue (t : SharedTypes.completionType) ~env ~full ~prefix
10371038
(constructor, variantDecl |> Shared.declToString variantName))
10381039
~env ())
10391040
|> filterItems ~prefix
1040-
| Some (Tpolyvariant {env; constructors; typeExpr}) ->
1041+
| Tpolyvariant {env; constructors; typeExpr} ->
10411042
constructors
10421043
|> List.map (fun (constructor : polyVariantConstructor) ->
10431044
Completion.createWithSnippet
@@ -1057,39 +1058,46 @@ let rec completeTypedValue (t : SharedTypes.completionType) ~env ~full ~prefix
10571058
(constructor, typeExpr |> Shared.typeToString))
10581059
~env ())
10591060
|> filterItems ~prefix
1060-
| Some (Toption (env, t)) ->
1061-
let innerType = Utils.unwrapIfOption t in
1061+
| Toption (env, t) ->
1062+
let innerType =
1063+
Utils.unwrapIfOption t |> TypeUtils.extractType ~env ~package:full.package
1064+
in
10621065
let expandedCompletions =
1063-
TypeExpr innerType
1064-
|> completeTypedValue ~env ~full ~prefix ~completionContext ~mode
1065-
|> List.map (fun (c : Completion.t) ->
1066-
{
1067-
c with
1068-
name = "Some(" ^ c.name ^ ")";
1069-
sortText = None;
1070-
insertText =
1071-
(match c.insertText with
1072-
| None -> None
1073-
| Some insertText -> Some ("Some(" ^ insertText ^ ")"));
1074-
})
1066+
innerType
1067+
|> Option.map (fun innerType ->
1068+
innerType
1069+
|> completeTypedValue ~full ~prefix ~completionContext ~mode
1070+
|> List.map (fun (c : Completion.t) ->
1071+
{
1072+
c with
1073+
name = "Some(" ^ c.name ^ ")";
1074+
sortText = None;
1075+
insertText =
1076+
(match c.insertText with
1077+
| None -> None
1078+
| Some insertText -> Some ("Some(" ^ insertText ^ ")"));
1079+
}))
10751080
in
1076-
[
1077-
Completion.create "None" ~kind:(Label (t |> Shared.typeToString)) ~env;
1078-
Completion.createWithSnippet ~name:"Some(_)"
1079-
~kind:(Label (t |> Shared.typeToString))
1080-
~env ~insertText:"Some(${1:_})" ();
1081-
]
1082-
@ expandedCompletions
1081+
([
1082+
Completion.create "None" ~kind:(Label (t |> Shared.typeToString)) ~env;
1083+
Completion.createWithSnippet ~name:"Some(_)"
1084+
~kind:(Label (t |> Shared.typeToString))
1085+
~env ~insertText:"Some(${1:_})" ();
1086+
]
1087+
@
1088+
match expandedCompletions with
1089+
| None -> []
1090+
| Some expandedCompletions -> expandedCompletions)
10831091
|> filterItems ~prefix
1084-
| Some (Tuple (env, exprs, typ)) ->
1092+
| Tuple (env, exprs, typ) ->
10851093
let numExprs = List.length exprs in
10861094
[
10871095
Completion.createWithSnippet
10881096
~name:(printConstructorArgs numExprs ~asSnippet:false)
10891097
~insertText:(printConstructorArgs numExprs ~asSnippet:true)
10901098
~kind:(Value typ) ~env ();
10911099
]
1092-
| Some (Trecord {env; fields} as extractedType) -> (
1100+
| Trecord {env; fields} as extractedType -> (
10931101
(* As we're completing for a record, we'll need a hint (completionContext)
10941102
here to figure out whether we should complete for a record field, or
10951103
the record body itself. *)
@@ -1112,7 +1120,7 @@ let rec completeTypedValue (t : SharedTypes.completionType) ~env ~full ~prefix
11121120
~sortText:"A" ~kind:(ExtractedType extractedType) ~env ();
11131121
]
11141122
else [])
1115-
| Some (TinlineRecord {env; fields}) -> (
1123+
| TinlineRecord {env; fields} -> (
11161124
match completionContext with
11171125
| Some (Completable.RecordField {seenFields}) ->
11181126
fields
@@ -1130,15 +1138,15 @@ let rec completeTypedValue (t : SharedTypes.completionType) ~env ~full ~prefix
11301138
~sortText:"A" ~kind:(Label "Inline record") ~env ();
11311139
]
11321140
else [])
1133-
| Some (Tarray (env, typeExpr)) ->
1141+
| Tarray (env, typeExpr) ->
11341142
if prefix = "" then
11351143
[
11361144
Completion.createWithSnippet ~name:"[]"
11371145
~insertText:(if !Cfg.supportsSnippets then "[$0]" else "[]")
11381146
~sortText:"A" ~kind:(Value typeExpr) ~env ();
11391147
]
11401148
else []
1141-
| Some (Tstring env) ->
1149+
| Tstring env ->
11421150
if prefix = "" then
11431151
[
11441152
Completion.createWithSnippet ~name:"\"\""
@@ -1149,7 +1157,7 @@ let rec completeTypedValue (t : SharedTypes.completionType) ~env ~full ~prefix
11491157
~env ();
11501158
]
11511159
else []
1152-
| Some (Tfunction {env; typ; args}) when prefix = "" && mode = Expression ->
1160+
| Tfunction {env; typ; args} when prefix = "" && mode = Expression ->
11531161
let prettyPrintArgTyp ?currentIndex (argTyp : Types.type_expr) =
11541162
let indexText =
11551163
match currentIndex with
@@ -1318,13 +1326,17 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover
13181326
|> completionsGetTypeEnv
13191327
with
13201328
| Some (typ, env) -> (
1321-
match TypeExpr typ |> TypeUtils.resolveNested ~env ~full ~nested with
1329+
match
1330+
typ
1331+
|> TypeUtils.extractType ~env ~package:full.package
1332+
|> Utils.Option.flatMap (fun typ ->
1333+
typ |> TypeUtils.resolveNested ~env ~full ~nested)
1334+
with
13221335
| None -> fallbackOrEmpty ()
1323-
| Some (typ, env, completionContext) ->
1336+
| Some (typ, _env, completionContext) ->
13241337
let items =
13251338
typ
1326-
|> completeTypedValue ~mode:Pattern ~env ~full ~prefix
1327-
~completionContext
1339+
|> completeTypedValue ~mode:Pattern ~full ~prefix ~completionContext
13281340
in
13291341
fallbackOrEmpty ~items ())
13301342
| None -> fallbackOrEmpty ())
@@ -1347,7 +1359,7 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover
13471359
in
13481360
let items =
13491361
typ
1350-
|> completeTypedValue ~mode:Expression ~env ~full ~prefix
1362+
|> completeTypedValue ~mode:Expression ~full ~prefix
13511363
~completionContext
13521364
|> List.map (fun (c : Completion.t) ->
13531365
if isJsx then

analysis/src/SharedTypes.ml

Lines changed: 3 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -294,8 +294,8 @@ end
294294

295295
type polyVariantConstructor = {name: string; args: Types.type_expr list}
296296

297-
(** An extracted type from a type expr *)
298-
type extractedType =
297+
(** An type that can be used to drive completion *)
298+
type completionType =
299299
| Tuple of QueryEnv.t * Types.type_expr list * Types.type_expr
300300
| Toption of QueryEnv.t * Types.type_expr
301301
| Tbool of QueryEnv.t
@@ -320,10 +320,6 @@ type extractedType =
320320
| TinlineRecord of {env: QueryEnv.t; fields: field list}
321321
| Tfunction of {env: QueryEnv.t; args: typedFnArg list; typ: Types.type_expr}
322322

323-
type completionType =
324-
| TypeExpr of Types.type_expr
325-
| ExtractedType of extractedType
326-
327323
module Completion = struct
328324
type kind =
329325
| Module of Module.t
@@ -336,7 +332,7 @@ module Completion = struct
336332
| Field of field * string
337333
| FileModule of string
338334
| Snippet of string
339-
| ExtractedType of extractedType
335+
| ExtractedType of completionType
340336

341337
type t = {
342338
name: string;

analysis/src/TypeUtils.ml

Lines changed: 46 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -255,51 +255,54 @@ let extractTypeFromResolvedType (typ : Type.t) ~env ~full =
255255
| None -> None
256256
| Some t -> t |> extractType ~env ~package:full.package)
257257

258-
let extractTypeFromCompletionType (t : completionType) ~env ~full =
259-
match t with
260-
| ExtractedType extractedType -> Some extractedType
261-
| TypeExpr t -> t |> extractType ~env ~package:full.package
262-
263258
(** This moves through a nested path via a set of instructions, trying to resolve the type at the end of the path. *)
264259
let rec resolveNested (typ : completionType) ~env ~full ~nested =
265260
match nested with
266261
| [] -> Some (typ, env, None)
267262
| patternPath :: nested -> (
268-
let extractedType = typ |> extractTypeFromCompletionType ~env ~full in
269-
match (patternPath, extractedType) with
270-
| Completable.NTupleItem {itemNum}, Some (Tuple (env, tupleItems, _)) -> (
263+
match (patternPath, typ) with
264+
| Completable.NTupleItem {itemNum}, Tuple (env, tupleItems, _) -> (
271265
match List.nth_opt tupleItems itemNum with
272266
| None -> None
273-
| Some typ -> TypeExpr typ |> resolveNested ~env ~full ~nested)
267+
| Some typ ->
268+
typ
269+
|> extractType ~env ~package:full.package
270+
|> Utils.Option.flatMap (fun typ ->
271+
typ |> resolveNested ~env ~full ~nested))
274272
| ( NFollowRecordField {fieldName},
275-
Some (TinlineRecord {env; fields} | Trecord {env; fields}) ) -> (
273+
(TinlineRecord {env; fields} | Trecord {env; fields}) ) -> (
276274
match
277275
fields
278276
|> List.find_opt (fun (field : field) -> field.fname.txt = fieldName)
279277
with
280278
| None -> None
281279
| Some {typ; optional} ->
282280
let typ = if optional then Utils.unwrapIfOption typ else typ in
283-
TypeExpr typ |> resolveNested ~env ~full ~nested)
284-
| NRecordBody {seenFields}, Some (Trecord {env; name = `TypeExpr typeExpr})
281+
typ
282+
|> extractType ~env ~package:full.package
283+
|> Utils.Option.flatMap (fun typ ->
284+
typ |> resolveNested ~env ~full ~nested))
285+
| NRecordBody {seenFields}, Trecord {env; name = `TypeExpr typeExpr} ->
286+
typeExpr
287+
|> extractType ~env ~package:full.package
288+
|> Option.map (fun typ ->
289+
(typ, env, Some (Completable.RecordField {seenFields})))
290+
| NRecordBody {seenFields}, (Trecord {env; name = `Str _} as extractedType)
285291
->
286-
Some (TypeExpr typeExpr, env, Some (Completable.RecordField {seenFields}))
287-
| ( NRecordBody {seenFields},
288-
Some (Trecord {env; name = `Str _} as extractedType) ) ->
292+
Some (extractedType, env, Some (Completable.RecordField {seenFields}))
293+
| NRecordBody {seenFields}, TinlineRecord {env; fields} ->
289294
Some
290-
( ExtractedType extractedType,
295+
( TinlineRecord {fields; env},
291296
env,
292297
Some (Completable.RecordField {seenFields}) )
293-
| NRecordBody {seenFields}, Some (TinlineRecord {env; fields}) ->
294-
Some
295-
( ExtractedType (TinlineRecord {fields; env}),
296-
env,
297-
Some (Completable.RecordField {seenFields}) )
298-
| ( NVariantPayload {constructorName = "Some"; itemNum = 0},
299-
Some (Toption (env, typ)) ) ->
300-
TypeExpr typ |> resolveNested ~env ~full ~nested
301-
| ( NVariantPayload {constructorName; itemNum},
302-
Some (Tvariant {env; constructors}) ) -> (
298+
| NVariantPayload {constructorName = "Some"; itemNum = 0}, Toption (env, typ)
299+
->
300+
typ
301+
|> extractType ~env ~package:full.package
302+
|> Utils.Option.flatMap (fun typ ->
303+
typ |> resolveNested ~env ~full ~nested)
304+
| NVariantPayload {constructorName; itemNum}, Tvariant {env; constructors}
305+
-> (
303306
match
304307
constructors
305308
|> List.find_opt (fun (c : Constructor.t) ->
@@ -308,13 +311,16 @@ let rec resolveNested (typ : completionType) ~env ~full ~nested =
308311
| Some {args = Args args} -> (
309312
match List.nth_opt args itemNum with
310313
| None -> None
311-
| Some (typ, _) -> TypeExpr typ |> resolveNested ~env ~full ~nested)
314+
| Some (typ, _) ->
315+
typ
316+
|> extractType ~env ~package:full.package
317+
|> Utils.Option.flatMap (fun typ ->
318+
typ |> resolveNested ~env ~full ~nested))
312319
| Some {args = InlineRecord fields} when itemNum = 0 ->
313-
ExtractedType (TinlineRecord {env; fields})
314-
|> resolveNested ~env ~full ~nested
320+
TinlineRecord {env; fields} |> resolveNested ~env ~full ~nested
315321
| _ -> None)
316322
| ( NPolyvariantPayload {constructorName; itemNum},
317-
Some (Tpolyvariant {env; constructors}) ) -> (
323+
Tpolyvariant {env; constructors} ) -> (
318324
match
319325
constructors
320326
|> List.find_opt (fun (c : polyVariantConstructor) ->
@@ -324,9 +330,16 @@ let rec resolveNested (typ : completionType) ~env ~full ~nested =
324330
| Some constructor -> (
325331
match List.nth_opt constructor.args itemNum with
326332
| None -> None
327-
| Some typ -> TypeExpr typ |> resolveNested ~env ~full ~nested))
328-
| NArray, Some (Tarray (env, typ)) ->
329-
TypeExpr typ |> resolveNested ~env ~full ~nested
333+
| Some typ ->
334+
typ
335+
|> extractType ~env ~package:full.package
336+
|> Utils.Option.flatMap (fun typ ->
337+
typ |> resolveNested ~env ~full ~nested)))
338+
| NArray, Tarray (env, typ) ->
339+
typ
340+
|> extractType ~env ~package:full.package
341+
|> Utils.Option.flatMap (fun typ ->
342+
typ |> resolveNested ~env ~full ~nested)
330343
| _ -> None)
331344

332345
let getArgs ~env (t : Types.type_expr) ~full =

analysis/src/Utils.ml

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -212,3 +212,10 @@ let rec expandPath (path : Path.t) =
212212
| Pident id -> [Ident.name id]
213213
| Pdot (p, s, _) -> s :: expandPath p
214214
| Papply _ -> []
215+
216+
module Option = struct
217+
let flatMap f o =
218+
match o with
219+
| None -> None
220+
| Some v -> f v
221+
end

0 commit comments

Comments
 (0)