@@ -229,12 +229,13 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads =
229
229
let result = ref None in
230
230
let printThing thg =
231
231
match thg with
232
- | `Constructor _ -> " Constructor"
232
+ | `ConstructorExpr _ -> " Constructor(expr)"
233
+ | `ConstructorPat _ -> " Constructor(pat)"
233
234
| `FunctionCall _ -> " FunctionCall"
234
235
in
235
236
let setResult (loc , thing ) =
236
237
match (thing, allowForConstructorPayloads) with
237
- | `Constructor _ , false -> ()
238
+ | ( `ConstructorExpr _ | `ConstructorPat _ ) , false -> ()
238
239
| _ -> (
239
240
match ! result with
240
241
| None ->
@@ -364,11 +365,20 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads =
364
365
|| CompletionExpressions. isExprHole payloadExp
365
366
&& locHasCursor pexp_loc ->
366
367
(* Constructor payloads *)
367
- setResult (lid.loc, `Constructor (lid, payloadExp))
368
+ setResult (lid.loc, `ConstructorExpr (lid, payloadExp))
368
369
| _ -> () );
369
370
Ast_iterator. default_iterator.expr iterator expr
370
371
in
371
- let iterator = {Ast_iterator. default_iterator with expr} in
372
+ let pat (iterator : Ast_iterator.iterator ) (pat : Parsetree.pattern ) =
373
+ (match pat with
374
+ | {ppat_desc = Ppat_construct (lid, Some payloadPat)}
375
+ when locHasCursor payloadPat.ppat_loc ->
376
+ (* Constructor payloads *)
377
+ setResult (lid.loc, `ConstructorPat (lid, payloadPat))
378
+ | _ -> () );
379
+ Ast_iterator. default_iterator.pat iterator pat
380
+ in
381
+ let iterator = {Ast_iterator. default_iterator with expr; pat} in
372
382
let parser =
373
383
Res_driver. parsingEngine.parseImplementation ~for Printer:false
374
384
in
@@ -474,9 +484,10 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads =
474
484
| activeParameter -> activeParameter);
475
485
}
476
486
| _ -> None )
477
- | Some (_ , `Constructor (lid , expr )) -> (
487
+ | Some (_, ((`ConstructorExpr (lid, _) | `ConstructorPat (lid, _)) as cs))
488
+ -> (
478
489
if Debug. verbose () then
479
- Printf. printf " [signature_help] Found constructor expr !\n " ;
490
+ Printf. printf " [signature_help] Found constructor!\n " ;
480
491
match Cmt. loadFullCmtFromPath ~path with
481
492
| None ->
482
493
if Debug. verbose () then
@@ -560,8 +571,8 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads =
560
571
^ " )"
561
572
in
562
573
let activeParameter =
563
- match expr with
564
- | {pexp_desc = Pexp_tuple items } -> (
574
+ match cs with
575
+ | `ConstructorExpr ( _ , {pexp_desc = Pexp_tuple items } ) -> (
565
576
let idx = ref 0 in
566
577
let tupleItemWithCursor =
567
578
items
@@ -574,7 +585,7 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads =
574
585
match tupleItemWithCursor with
575
586
| None -> - 1
576
587
| Some i -> i)
577
- | {pexp_desc = Pexp_record (fields , _ )} -> (
588
+ | `ConstructorExpr ( _ , {pexp_desc = Pexp_record (fields , _ )} ) -> (
578
589
let fieldNameWithCursor =
579
590
fields
580
591
|> List. find_map
@@ -602,7 +613,49 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads =
602
613
else () );
603
614
! fieldIndex
604
615
| _ -> - 1 )
605
- | _ when locHasCursor expr.pexp_loc -> 0
616
+ | `ConstructorExpr (_ , expr ) when locHasCursor expr.pexp_loc -> 0
617
+ | `ConstructorPat (_ , {ppat_desc = Ppat_tuple items } ) -> (
618
+ let idx = ref 0 in
619
+ let tupleItemWithCursor =
620
+ items
621
+ |> List. find_map (fun (item : Parsetree.pattern ) ->
622
+ let currentIndex = ! idx in
623
+ idx := currentIndex + 1 ;
624
+ if locHasCursor item.ppat_loc then Some currentIndex
625
+ else None )
626
+ in
627
+ match tupleItemWithCursor with
628
+ | None -> - 1
629
+ | Some i -> i)
630
+ | `ConstructorPat (_ , {ppat_desc = Ppat_record (fields , _ )} ) -> (
631
+ let fieldNameWithCursor =
632
+ fields
633
+ |> List. find_map
634
+ (fun
635
+ (({loc; txt} , pat ) :
636
+ Longident. t Location. loc * Parsetree. pattern )
637
+ ->
638
+ if
639
+ posBeforeCursor > = Pos. ofLexing loc.loc_start
640
+ && posBeforeCursor
641
+ < = Pos. ofLexing pat.ppat_loc.loc_end
642
+ then Some (Longident. last txt)
643
+ else None )
644
+ in
645
+ match (fieldNameWithCursor, argParts) with
646
+ | Some fieldName , Some (`InlineRecord fields ) ->
647
+ let idx = ref 0 in
648
+ let fieldIndex = ref (- 1 ) in
649
+ fields
650
+ |> List. iter (fun (_ , field , _ ) ->
651
+ idx := ! idx + 1 ;
652
+ let currentIndex = ! idx in
653
+ if fieldName = field.fname.txt then
654
+ fieldIndex := currentIndex
655
+ else () );
656
+ ! fieldIndex
657
+ | _ -> - 1 )
658
+ | `ConstructorPat (_ , pat ) when locHasCursor pat.ppat_loc -> 0
606
659
| _ -> - 1
607
660
in
608
661
0 commit comments