Skip to content

Commit 00a1c75

Browse files
zthzth
committed
descend through variant payloads
1 parent dc428da commit 00a1c75

File tree

6 files changed

+172
-58
lines changed

6 files changed

+172
-58
lines changed

‎analysis/src/CompletionBackEnd.ml

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1772,6 +1772,18 @@ let rec resolveNestedPattern typ ~env ~package ~nested =
17721772
| Some {typ} -> typ |> resolveNestedPattern ~env ~package ~nested)
17731773
| PRecordBody {seenFields}, Some (Trecord {env; typeExpr}) ->
17741774
Some (typeExpr, env, Some (Completable.RecordField {seenFields}))
1775+
| ( PVariantPayload {constructorName; payloadNum},
1776+
Some (Tvariant {env; constructors}) ) -> (
1777+
match
1778+
constructors
1779+
|> List.find_opt (fun (c : Constructor.t) ->
1780+
c.cname.txt = constructorName)
1781+
with
1782+
| None -> None
1783+
| Some constructor -> (
1784+
match List.nth_opt constructor.args payloadNum with
1785+
| None -> None
1786+
| Some (typ, _) -> typ |> resolveNestedPattern ~env ~package ~nested))
17751787
| _ -> None)
17761788

17771789
let processCompletable ~debug ~full ~scope ~env ~pos ~forHover

‎analysis/src/CompletionFrontEnd.ml

Lines changed: 73 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -257,6 +257,12 @@ let rec exprToContextPath (e : Parsetree.expression) =
257257
| Some contexPath -> Some (CPApply (contexPath, args |> List.map fst)))
258258
| _ -> None
259259

260+
let rec getUnqualifiedName txt =
261+
match txt with
262+
| Longident.Lident fieldName -> fieldName
263+
| Ldot (t, _) -> getUnqualifiedName t
264+
| _ -> ""
265+
260266
let completePipeChain ~(lhs : Parsetree.expression) =
261267
(* Complete the end of pipe chains by reconstructing the pipe chain as a single pipe,
262268
so it can be completed.
@@ -299,6 +305,20 @@ let completePipeChain ~(lhs : Parsetree.expression) =
299305
|> Option.map (fun ctxPath -> (ctxPath, pexp_loc))
300306
| _ -> None
301307

308+
let findPatTupleItemWithCursor patterns ~pos =
309+
let patCount = ref None in
310+
let patCountWithPatHole = ref None in
311+
patterns
312+
|> List.iteri (fun index p ->
313+
match p.Parsetree.ppat_loc |> CursorPosition.classifyLoc ~pos with
314+
| HasCursor -> patCount := Some index
315+
| EmptyLoc -> patCountWithPatHole := Some index
316+
| _ -> ());
317+
match (!patCount, !patCountWithPatHole) with
318+
| Some patCount, _ -> Some patCount
319+
| None, Some patHoleCount -> Some patHoleCount
320+
| _ -> None
321+
302322
let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
303323
let offsetNoWhite = Utils.skipWhite text (offset - 1) in
304324
let posNoWhite =
@@ -487,23 +507,11 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
487507
then
488508
match pat.ppat_desc with
489509
| Ppat_var {txt} -> commitFoundPat ~prefix:txt ()
510+
| Ppat_construct ({txt = Lident prefix}, None) ->
511+
commitFoundPat ~prefix ()
490512
| Ppat_tuple patterns -> (
491-
let patCount = ref None in
492-
let patCountWithPatHole = ref None in
493-
patterns
494-
|> List.iteri (fun index p ->
495-
match
496-
p.Parsetree.ppat_loc
497-
|> CursorPosition.classifyLoc ~pos:posBeforeCursor
498-
with
499-
| HasCursor -> patCount := Some index
500-
| EmptyLoc -> patCountWithPatHole := Some index
501-
| _ -> ());
502-
match (!patCount, !patCountWithPatHole) with
503-
| Some patCount, _ ->
504-
appendNestedPat (Completable.PTupleItem {itemNum = patCount})
505-
| None, Some patHoleCount ->
506-
appendNestedPat (Completable.PTupleItem {itemNum = patHoleCount})
513+
match patterns |> findPatTupleItemWithCursor ~pos:posBeforeCursor with
514+
| Some itemNum -> appendNestedPat (Completable.PTupleItem {itemNum})
507515
| _ -> ())
508516
| Ppat_record ([], _) ->
509517
(* Empty fields means we're in a record body `{}`. Complete for the fields. *)
@@ -556,6 +564,46 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
556564
appendNestedPat (Completable.PRecordBody {seenFields});
557565
commitFoundPat ~prefix:"" ()
558566
| _ -> ()))
567+
| Ppat_construct
568+
( {txt},
569+
Some {ppat_loc; ppat_desc = Ppat_construct ({txt = Lident "()"}, _)}
570+
)
571+
when ppat_loc
572+
|> CursorPosition.classifyLoc ~pos:posBeforeCursor
573+
= HasCursor ->
574+
(* Empty payload *)
575+
appendNestedPat
576+
(Completable.PVariantPayload
577+
{constructorName = getUnqualifiedName txt; payloadNum = 0});
578+
commitFoundPat ~prefix:"" ()
579+
| Ppat_construct
580+
( {txt},
581+
Some
582+
{
583+
ppat_loc;
584+
ppat_desc =
585+
Ppat_var _ | Ppat_record _ | Ppat_construct _ | Ppat_variant _;
586+
} )
587+
when ppat_loc
588+
|> CursorPosition.classifyLoc ~pos:posBeforeCursor
589+
= HasCursor ->
590+
(* Single payload *)
591+
appendNestedPat
592+
(Completable.PVariantPayload
593+
{constructorName = getUnqualifiedName txt; payloadNum = 0})
594+
| Ppat_construct
595+
({txt}, Some {ppat_loc; ppat_desc = Ppat_tuple tupleItems})
596+
when ppat_loc
597+
|> CursorPosition.classifyLoc ~pos:posBeforeCursor
598+
= HasCursor -> (
599+
(* Multiple payloads with cursor in item *)
600+
(* TODO: New item with comma *)
601+
match tupleItems |> findPatTupleItemWithCursor ~pos:posBeforeCursor with
602+
| None -> ()
603+
| Some payloadNum ->
604+
appendNestedPat
605+
(Completable.PVariantPayload
606+
{constructorName = getUnqualifiedName txt; payloadNum}))
559607
| _ -> ()
560608
in
561609
let case (iterator : Ast_iterator.iterator) (case : Parsetree.case) =
@@ -951,21 +999,26 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
951999
let pat (iterator : Ast_iterator.iterator) (pat : Parsetree.pattern) =
9521000
if pat.ppat_loc |> Loc.hasPos ~pos:posNoWhite then (
9531001
found := true;
1002+
let oldLookingForPat = !lookingForPat in
1003+
typedCompletionPat pat;
9541004
if debug then
9551005
Printf.printf "posCursor:[%s] posNoWhite:[%s] Found pattern:%s\n"
9561006
(Pos.toString posCursor) (Pos.toString posNoWhite)
9571007
(Loc.toString pat.ppat_loc);
958-
(match pat.ppat_desc with
959-
| Ppat_construct (lid, _) ->
1008+
(* TODO:
1009+
This change breaks old behavior of completing constructors in scope.
1010+
Either be fine with it, fix it somehow, or incorporate completing
1011+
constructors in scope when regular completion for variants can't
1012+
be done. *)
1013+
(match (!lookingForPat, pat.ppat_desc) with
1014+
| None, Ppat_construct (lid, _) ->
9601015
let lidPath = flattenLidCheckDot lid in
9611016
if debug then
9621017
Printf.printf "Ppat_construct %s:%s\n"
9631018
(lidPath |> String.concat ".")
9641019
(Loc.toString lid.loc);
9651020
setResult (Cpath (CPId (lidPath, Value)))
9661021
| _ -> ());
967-
let oldLookingForPat = !lookingForPat in
968-
typedCompletionPat pat;
9691022
Ast_iterator.default_iterator.pat iterator pat;
9701023
lookingForPat := oldLookingForPat)
9711024
in

‎analysis/src/SharedTypes.ml

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -557,12 +557,16 @@ module Completable = struct
557557
| PTupleItem of {itemNum: int}
558558
| PFollowRecordField of {fieldName: string}
559559
| PRecordBody of {seenFields: string list}
560+
| PVariantPayload of {constructorName: string; payloadNum: int}
560561

561562
let patternPathToString p =
562563
match p with
563564
| PTupleItem {itemNum} -> "tuple($" ^ string_of_int itemNum ^ ")"
564565
| PFollowRecordField {fieldName} -> "recordField(" ^ fieldName ^ ")"
565566
| PRecordBody _ -> "recordBody"
567+
| PVariantPayload {constructorName; payloadNum} ->
568+
"variantPayload::" ^ constructorName ^ "($" ^ string_of_int payloadNum
569+
^ ")"
566570

567571
type t =
568572
| Cdecorator of string (** e.g. @module *)

‎analysis/tests/src/CompletionPattern.res

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -78,3 +78,17 @@ let _ = switch f {
7878

7979
// let {nest: {n}}} = f
8080
// ^com
81+
82+
type someVariant = One | Two(bool) | Three(someRecord, bool)
83+
84+
let z = Two(true)
85+
ignore(z)
86+
87+
// switch z { | Two()}
88+
// ^com
89+
90+
// switch z { | Two(t)}
91+
// ^com
92+
93+
// switch z { | Three({})}
94+
// ^com

‎analysis/tests/src/expected/Completion.res.txt

Lines changed: 3 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -1447,53 +1447,18 @@ looking for: Cpath Value[x]
14471447
posCursor:[362:8] posNoWhite:[362:7] Found expr:[361:2->365:3]
14481448
posCursor:[362:8] posNoWhite:[362:7] Found pattern:[362:7->364:5]
14491449
posCursor:[362:8] posNoWhite:[362:7] Found pattern:[362:7->362:8]
1450-
Ppat_construct T:[362:7->362:8]
1451-
Completable: Cpath Value[T]
1450+
Completable: Cpattern Value[x]=T
14521451
Raw opens: 2 Shadow.B.place holder ... Shadow.A.place holder
14531452
Resolved opens 2 Completion.res Completion.res
1454-
[{
1455-
"label": "That",
1456-
"kind": 4,
1457-
"tags": [],
1458-
"detail": "That\n\ntype v = This | That",
1459-
"documentation": null
1460-
}, {
1461-
"label": "This",
1462-
"kind": 4,
1463-
"tags": [],
1464-
"detail": "This\n\ntype v = This | That",
1465-
"documentation": null
1466-
}, {
1467-
"label": "TableclothMap",
1468-
"kind": 9,
1469-
"tags": [],
1470-
"detail": "file module",
1471-
"documentation": null
1472-
}, {
1473-
"label": "TypeDefinition",
1474-
"kind": 9,
1475-
"tags": [],
1476-
"detail": "file module",
1477-
"documentation": null
1478-
}]
1453+
[]
14791454

14801455
Complete src/Completion.res 373:21
14811456
posCursor:[373:21] posNoWhite:[373:20] Found expr:[371:8->376:3]
14821457
looking for: Cpath Value[x]
14831458
posCursor:[373:21] posNoWhite:[373:20] Found expr:[372:2->376:3]
14841459
posCursor:[373:21] posNoWhite:[373:20] Found pattern:[373:7->375:5]
14851460
posCursor:[373:21] posNoWhite:[373:20] Found pattern:[373:7->373:21]
1486-
Ppat_construct AndThatOther.T:[373:7->373:21]
1487-
Completable: Cpath Value[AndThatOther, T]
1488-
Raw opens: 2 Shadow.B.place holder ... Shadow.A.place holder
1489-
Resolved opens 2 Completion.res Completion.res
1490-
[{
1491-
"label": "ThatOther",
1492-
"kind": 4,
1493-
"tags": [],
1494-
"detail": "ThatOther\n\ntype v = And | ThatOther",
1495-
"documentation": null
1496-
}]
1461+
[]
14971462

14981463
Complete src/Completion.res 378:24
14991464
posCursor:[378:24] posNoWhite:[378:23] Found expr:[378:12->378:26]

‎analysis/tests/src/expected/CompletionPattern.res.txt

Lines changed: 66 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -258,3 +258,69 @@ Completable: Cpattern Value[f]=n->recordField(nest), recordBody
258258
"documentation": null
259259
}]
260260

261+
Complete src/CompletionPattern.res 86:20
262+
looking for: Cpath Value[z]
263+
posCursor:[86:20] posNoWhite:[86:19] Found expr:[86:3->86:22]
264+
posCursor:[86:20] posNoWhite:[86:19] Found pattern:[86:16->86:21]
265+
posCursor:[86:20] posNoWhite:[86:19] Found pattern:[86:19->86:21]
266+
Completable: Cpattern Value[z]->variantPayload::Two($0)
267+
[{
268+
"label": "true",
269+
"kind": 4,
270+
"tags": [],
271+
"detail": "bool",
272+
"documentation": null
273+
}, {
274+
"label": "false",
275+
"kind": 4,
276+
"tags": [],
277+
"detail": "bool",
278+
"documentation": null
279+
}]
280+
281+
Complete src/CompletionPattern.res 89:21
282+
looking for: Cpath Value[z]
283+
posCursor:[89:21] posNoWhite:[89:20] Found expr:[89:3->89:23]
284+
posCursor:[89:21] posNoWhite:[89:20] Found pattern:[89:16->89:22]
285+
posCursor:[89:21] posNoWhite:[89:20] Found pattern:[89:20->89:21]
286+
Completable: Cpattern Value[z]=t->variantPayload::Two($0)
287+
[{
288+
"label": "true",
289+
"kind": 4,
290+
"tags": [],
291+
"detail": "bool",
292+
"documentation": null
293+
}]
294+
295+
Complete src/CompletionPattern.res 92:23
296+
looking for: Cpath Value[z]
297+
posCursor:[92:23] posNoWhite:[92:22] Found expr:[92:3->92:26]
298+
posCursor:[92:23] posNoWhite:[92:22] Found pattern:[92:16->92:25]
299+
posCursor:[92:23] posNoWhite:[92:22] Found pattern:[92:22->92:24]
300+
Completable: Cpattern Value[z]->variantPayload::Three($0), recordBody
301+
[{
302+
"label": "first",
303+
"kind": 5,
304+
"tags": [],
305+
"detail": "first: int\n\nsomeRecord",
306+
"documentation": null
307+
}, {
308+
"label": "second",
309+
"kind": 5,
310+
"tags": [],
311+
"detail": "second: (bool, option<someRecord>)\n\nsomeRecord",
312+
"documentation": null
313+
}, {
314+
"label": "optThird",
315+
"kind": 5,
316+
"tags": [],
317+
"detail": "optThird: option<[#second(someRecord) | #first]>\n\nsomeRecord",
318+
"documentation": null
319+
}, {
320+
"label": "nest",
321+
"kind": 5,
322+
"tags": [],
323+
"detail": "nest: nestedRecord\n\nsomeRecord",
324+
"documentation": null
325+
}]
326+

0 commit comments

Comments
 (0)