Skip to content

Commit 7f9ecb9

Browse files
zthzth
committed
support completing in/through inline records in variant payloads
1 parent 37cd3db commit 7f9ecb9

File tree

6 files changed

+232
-53
lines changed

6 files changed

+232
-53
lines changed

‎analysis/src/CompletionBackEnd.ml

Lines changed: 67 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -490,8 +490,8 @@ let domLabels =
490490
let showConstructor {Constructor.cname = {txt}; args; res} =
491491
txt
492492
^ (match args with
493-
| [] -> ""
494-
| _ ->
493+
| Args [] | InlineRecord _ -> ""
494+
| Args args ->
495495
"("
496496
^ (args
497497
|> List.map (fun (typ, _) -> typ |> Shared.typeToString)
@@ -1793,29 +1793,35 @@ let printConstructorArgs argsLen ~asSnippet =
17931793
if List.length !args > 0 then "(" ^ (!args |> String.concat ", ") ^ ")"
17941794
else ""
17951795

1796-
let rec completeTypedValue (t : Types.type_expr) ~env ~full ~prefix
1796+
let rec completeTypedValue (t : SharedTypes.completionType) ~env ~full ~prefix
17971797
~completionContext =
1798-
match t |> extractType ~env ~package:full.package with
1798+
let extractedType =
1799+
match t with
1800+
| TypeExpr t -> t |> extractType ~env ~package:full.package
1801+
| InlineRecord fields -> Some (TinlineRecord {env; fields})
1802+
in
1803+
match extractedType with
17991804
| Some (Tbool env) ->
18001805
[
1801-
Completion.create "true" ~kind:(Label (t |> Shared.typeToString)) ~env;
1802-
Completion.create "false" ~kind:(Label (t |> Shared.typeToString)) ~env;
1806+
Completion.create "true" ~kind:(Label "bool") ~env;
1807+
Completion.create "false" ~kind:(Label "bool") ~env;
18031808
]
18041809
|> filterItems ~prefix
18051810
| Some (Tvariant {env; constructors; variantDecl; variantName}) ->
18061811
constructors
18071812
|> List.map (fun (constructor : Constructor.t) ->
1813+
let numArgs =
1814+
match constructor.args with
1815+
| InlineRecord _ -> 1
1816+
| Args args -> List.length args
1817+
in
18081818
Completion.createWithSnippet
18091819
~name:
18101820
(constructor.cname.txt
1811-
^ printConstructorArgs
1812-
(List.length constructor.args)
1813-
~asSnippet:false)
1821+
^ printConstructorArgs numArgs ~asSnippet:false)
18141822
~insertText:
18151823
(constructor.cname.txt
1816-
^ printConstructorArgs
1817-
(List.length constructor.args)
1818-
~asSnippet:true)
1824+
^ printConstructorArgs numArgs ~asSnippet:true)
18191825
~kind:
18201826
(Constructor
18211827
(constructor, variantDecl |> Shared.declToString variantName))
@@ -1844,7 +1850,7 @@ let rec completeTypedValue (t : Types.type_expr) ~env ~full ~prefix
18441850
| Some (Toption (env, t)) ->
18451851
let innerType = Utils.unwrapIfOption t in
18461852
let expandedCompletions =
1847-
innerType
1853+
TypeExpr innerType
18481854
|> completeTypedValue ~env ~full ~prefix ~completionContext
18491855
|> List.map (fun (c : Completion.t) ->
18501856
{
@@ -1895,6 +1901,24 @@ let rec completeTypedValue (t : Types.type_expr) ~env ~full ~prefix
18951901
~sortText:"A" ~kind:(Value typeExpr) ~env ();
18961902
]
18971903
else [])
1904+
| Some (TinlineRecord {env; fields}) -> (
1905+
match completionContext with
1906+
| Some (Completable.RecordField {seenFields}) ->
1907+
fields
1908+
|> List.filter (fun (field : field) ->
1909+
List.mem field.fname.txt seenFields = false)
1910+
|> List.map (fun (field : field) ->
1911+
Completion.create field.fname.txt ~kind:(Label "Inline record")
1912+
~env)
1913+
|> filterItems ~prefix
1914+
| None ->
1915+
if prefix = "" then
1916+
[
1917+
Completion.createWithSnippet ~name:"{}"
1918+
~insertText:(if !Cfg.supportsSnippets then "{$0}" else "{}")
1919+
~sortText:"A" ~kind:(Label "Inline record") ~env ();
1920+
]
1921+
else [])
18981922
| Some (Tarray (env, typeExpr)) ->
18991923
if prefix = "" then
19001924
[
@@ -1917,41 +1941,52 @@ let rec completeTypedValue (t : Types.type_expr) ~env ~full ~prefix
19171941
| _ -> []
19181942

19191943
(** This moves through a nested path via a set of instructions, trying to resolve the type at the end of the path. *)
1920-
let rec resolveNested typ ~env ~package ~nested =
1944+
let rec resolveNested (typ : completionType) ~env ~package ~nested =
19211945
match nested with
19221946
| [] -> Some (typ, env, None)
19231947
| patternPath :: nested -> (
1924-
match (patternPath, typ |> extractType ~env ~package) with
1948+
let extractedType =
1949+
match typ with
1950+
| TypeExpr typ -> typ |> extractType ~env ~package
1951+
| InlineRecord fields -> Some (TinlineRecord {env; fields})
1952+
in
1953+
match (patternPath, extractedType) with
19251954
| Completable.NTupleItem {itemNum}, Some (Tuple (env, tupleItems, _)) -> (
19261955
match List.nth_opt tupleItems itemNum with
19271956
| None -> None
1928-
| Some typ -> typ |> resolveNested ~env ~package ~nested)
1929-
| NFollowRecordField {fieldName}, Some (Trecord {env; fields}) -> (
1957+
| Some typ -> TypeExpr typ |> resolveNested ~env ~package ~nested)
1958+
| ( NFollowRecordField {fieldName},
1959+
Some (TinlineRecord {env; fields} | Trecord {env; fields}) ) -> (
19301960
match
19311961
fields
19321962
|> List.find_opt (fun (field : field) -> field.fname.txt = fieldName)
19331963
with
19341964
| None -> None
19351965
| Some {typ; optional} ->
19361966
let typ = if optional then Utils.unwrapIfOption typ else typ in
1937-
typ |> resolveNested ~env ~package ~nested)
1967+
TypeExpr typ |> resolveNested ~env ~package ~nested)
19381968
| NRecordBody {seenFields}, Some (Trecord {env; typeExpr}) ->
1939-
Some (typeExpr, env, Some (Completable.RecordField {seenFields}))
1969+
Some (TypeExpr typeExpr, env, Some (Completable.RecordField {seenFields}))
1970+
| NRecordBody {seenFields}, Some (TinlineRecord {env; fields}) ->
1971+
Some
1972+
(InlineRecord fields, env, Some (Completable.RecordField {seenFields}))
19401973
| ( NVariantPayload {constructorName = "Some"; itemNum = 0},
19411974
Some (Toption (env, typ)) ) ->
1942-
typ |> resolveNested ~env ~package ~nested
1975+
TypeExpr typ |> resolveNested ~env ~package ~nested
19431976
| ( NVariantPayload {constructorName; itemNum},
19441977
Some (Tvariant {env; constructors}) ) -> (
19451978
match
19461979
constructors
19471980
|> List.find_opt (fun (c : Constructor.t) ->
19481981
c.cname.txt = constructorName)
19491982
with
1950-
| None -> None
1951-
| Some constructor -> (
1952-
match List.nth_opt constructor.args itemNum with
1983+
| Some {args = Args args} -> (
1984+
match List.nth_opt args itemNum with
19531985
| None -> None
1954-
| Some (typ, _) -> typ |> resolveNested ~env ~package ~nested))
1986+
| Some (typ, _) -> TypeExpr typ |> resolveNested ~env ~package ~nested)
1987+
| Some {args = InlineRecord fields} when itemNum = 0 ->
1988+
InlineRecord fields |> resolveNested ~env ~package ~nested
1989+
| _ -> None)
19551990
| ( NPolyvariantPayload {constructorName; itemNum},
19561991
Some (Tpolyvariant {env; constructors}) ) -> (
19571992
match
@@ -1963,9 +1998,9 @@ let rec resolveNested typ ~env ~package ~nested =
19631998
| Some constructor -> (
19641999
match List.nth_opt constructor.args itemNum with
19652000
| None -> None
1966-
| Some typ -> typ |> resolveNested ~env ~package ~nested))
2001+
| Some typ -> TypeExpr typ |> resolveNested ~env ~package ~nested))
19672002
| NArray, Some (Tarray (env, typ)) ->
1968-
typ |> resolveNested ~env ~package ~nested
2003+
TypeExpr typ |> resolveNested ~env ~package ~nested
19692004
| _ -> None)
19702005

19712006
let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover
@@ -2301,7 +2336,9 @@ Note: The `@react.component` decorator requires the react-jsx config to be set i
23012336
|> completionsGetTypeEnv
23022337
with
23032338
| Some (typ, env) -> (
2304-
match typ |> resolveNested ~env ~package:full.package ~nested with
2339+
match
2340+
TypeExpr typ |> resolveNested ~env ~package:full.package ~nested
2341+
with
23052342
| None -> fallbackOrEmpty ()
23062343
| Some (typ, env, completionContext) ->
23072344
let items =
@@ -2318,7 +2355,9 @@ Note: The `@react.component` decorator requires the react-jsx config to be set i
23182355
with
23192356
| None -> []
23202357
| Some (typ, env) -> (
2321-
match typ |> resolveNested ~env ~package:full.package ~nested with
2358+
match
2359+
TypeExpr typ |> resolveNested ~env ~package:full.package ~nested
2360+
with
23222361
| None -> []
23232362
| Some (typ, env, completionContext) -> (
23242363
let items =

‎analysis/src/Hover.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -245,8 +245,8 @@ let newHover ~full:{file; package} ~supportsMarkdownLinks locItem =
245245
let typeString, docstring = t |> fromType ~docstring in
246246
let argsString =
247247
match args with
248-
| [] -> ""
249-
| _ ->
248+
| InlineRecord _ | Args [] -> ""
249+
| Args args ->
250250
args
251251
|> List.map (fun (t, _) -> Shared.typeToString t)
252252
|> String.concat ", " |> Printf.sprintf "(%s)"

‎analysis/src/ProcessCmt.ml

Lines changed: 49 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,20 @@ let attrsToDocstring attrs =
1515
| None -> []
1616
| Some docstring -> [docstring]
1717

18+
let mapRecordField {Types.ld_id; ld_type; ld_attributes} =
19+
let astamp = Ident.binding_time ld_id in
20+
let name = Ident.name ld_id in
21+
{
22+
stamp = astamp;
23+
fname = Location.mknoloc name;
24+
typ = ld_type;
25+
optional = Res_parsetree_viewer.hasOptionalAttribute ld_attributes;
26+
docstring =
27+
(match ProcessAttributes.findDocAttribute ld_attributes with
28+
| None -> []
29+
| Some docstring -> [docstring]);
30+
}
31+
1832
let rec forTypeSignatureItem ~(env : SharedTypes.Env.t) ~(exported : Exported.t)
1933
(item : Types.signature_item) =
2034
match item with
@@ -76,9 +90,11 @@ let rec forTypeSignatureItem ~(env : SharedTypes.Env.t) ~(exported : Exported.t)
7690
args =
7791
(match cd_args with
7892
| Cstr_tuple args ->
79-
args |> List.map (fun t -> (t, Location.none))
80-
(* TODO(406): constructor record args support *)
81-
| Cstr_record _ -> []);
93+
Args
94+
(args
95+
|> List.map (fun t -> (t, Location.none)))
96+
| Cstr_record fields ->
97+
InlineRecord (fields |> List.map mapRecordField));
8298
res = cd_res;
8399
typeDecl = (name, decl);
84100
docstring = attrsToDocstring cd_attributes;
@@ -93,20 +109,7 @@ let rec forTypeSignatureItem ~(env : SharedTypes.Env.t) ~(exported : Exported.t)
93109
Stamps.addConstructor env.stamps stamp declared;
94110
item))
95111
| Type_record (fields, _) ->
96-
Record
97-
(fields
98-
|> List.map (fun {Types.ld_id; ld_type; ld_attributes} ->
99-
let astamp = Ident.binding_time ld_id in
100-
let name = Ident.name ld_id in
101-
{
102-
stamp = astamp;
103-
fname = Location.mknoloc name;
104-
typ = ld_type;
105-
optional =
106-
Res_parsetree_viewer.hasOptionalAttribute
107-
ld_attributes;
108-
docstring = attrsToDocstring ld_attributes;
109-
})));
112+
Record (fields |> List.map mapRecordField));
110113
}
111114
~name ~stamp:(Ident.binding_time ident) ~env type_attributes
112115
(Exported.add exported Exported.Type)
@@ -198,11 +201,35 @@ let forTypeDeclaration ~env ~(exported : Exported.t)
198201
args =
199202
(match cd_args with
200203
| Cstr_tuple args ->
201-
args
202-
|> List.map (fun t ->
203-
(t.Typedtree.ctyp_type, t.ctyp_loc))
204-
(* TODO(406) *)
205-
| Cstr_record _ -> []);
204+
Args
205+
(args
206+
|> List.map (fun t ->
207+
(t.Typedtree.ctyp_type, t.ctyp_loc)))
208+
| Cstr_record fields ->
209+
InlineRecord
210+
(fields
211+
|> List.map
212+
(fun (f : Typedtree.label_declaration) ->
213+
let astamp =
214+
Ident.binding_time f.ld_id
215+
in
216+
let name = Ident.name f.ld_id in
217+
{
218+
stamp = astamp;
219+
fname = Location.mknoloc name;
220+
typ = f.ld_type.ctyp_type;
221+
optional =
222+
Res_parsetree_viewer
223+
.hasOptionalAttribute
224+
f.ld_attributes;
225+
docstring =
226+
(match
227+
ProcessAttributes
228+
.findDocAttribute f.ld_attributes
229+
with
230+
| None -> []
231+
| Some docstring -> [docstring]);
232+
})));
206233
res =
207234
(match cd_res with
208235
| None -> None

‎analysis/src/SharedTypes.ml

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -32,11 +32,17 @@ type field = {
3232
docstring: string list;
3333
}
3434

35+
type completionType = TypeExpr of Types.type_expr | InlineRecord of field list
36+
37+
type constructorArgs =
38+
| InlineRecord of field list
39+
| Args of (Types.type_expr * Location.t) list
40+
3541
module Constructor = struct
3642
type t = {
3743
stamp: int;
3844
cname: string Location.loc;
39-
args: (Types.type_expr * Location.t) list;
45+
args: constructorArgs;
4046
res: Types.type_expr option;
4147
typeDecl: string * Types.type_declaration;
4248
docstring: string list;
@@ -631,6 +637,7 @@ module Completable = struct
631637
fields: field list;
632638
typeExpr: Types.type_expr;
633639
}
640+
| TinlineRecord of {env: QueryEnv.t; fields: field list}
634641

635642
let toString =
636643
let completionContextToString = function

‎analysis/tests/src/CompletionExpressions.res

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -116,3 +116,25 @@ let fnTakingRecordWithOptVariant = (r: recordWithOptVariant) => {
116116

117117
// let _ = fnTakingRecordWithOptVariant({someVariant: })
118118
// ^com
119+
120+
type variantWithInlineRecord =
121+
WithInlineRecord({someBoolField: bool, otherField: option<bool>, nestedRecord: otherRecord})
122+
123+
let fnTakingInlineRecord = (r: variantWithInlineRecord) => {
124+
ignore(r)
125+
}
126+
127+
// let _ = fnTakingInlineRecord(WithInlineRecord())
128+
// ^com
129+
130+
// let _ = fnTakingInlineRecord(WithInlineRecord({}))
131+
// ^com
132+
133+
// let _ = fnTakingInlineRecord(WithInlineRecord({s}))
134+
// ^com
135+
136+
// let _ = fnTakingInlineRecord(WithInlineRecord({nestedRecord: }))
137+
// ^com
138+
139+
// let _ = fnTakingInlineRecord(WithInlineRecord({nestedRecord: {} }))
140+
// ^com

0 commit comments

Comments
 (0)