Skip to content

Commit fdaa98f

Browse files
zthzth
committed
wip
1 parent be4eee8 commit fdaa98f

File tree

4 files changed

+199
-108
lines changed

4 files changed

+199
-108
lines changed

‎analysis/src/CompletionFrontEndNew.ml

+138-71
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ module PositionContext = struct
77
beforeCursor: Pos.t; (** The position just before the cursor *)
88
noWhitespace: Pos.t;
99
(** The position of the cursor, removing any whitespace _before_ it *)
10-
firstCharBeforeNoWhitespace: char option;
10+
charBeforeNoWhitespace: char option;
1111
(** The first character before the cursor, excluding any whitespace *)
1212
charBeforeCursor: char option;
1313
(** The char before the cursor, not excluding whitespace *)
@@ -44,7 +44,7 @@ module PositionContext = struct
4444
offset;
4545
beforeCursor = posBeforeCursor;
4646
noWhitespace = posNoWhite;
47-
firstCharBeforeNoWhitespace = firstCharBeforeCursorNoWhite;
47+
charBeforeNoWhitespace = firstCharBeforeCursorNoWhite;
4848
cursor = posCursor;
4949
charBeforeCursor;
5050
whitespaceAfterCursor;
@@ -60,8 +60,10 @@ type ctxPath =
6060
(** A variant payload. `Some(<com>)` = itemNum 0, `Whatever(true, f<com>)` = itemNum 1*)
6161
| CRecordField of {seenFields: string list; prefix: string}
6262
(** A record field. `let f = {on: true, s<com>}` seenFields = [on], prefix = "s",*)
63+
| COption of ctxPath (** An option with an inner type. *)
64+
| CArray of ctxPath option (** An array with an inner type. *)
6365

64-
let ctxPathToString (ctxPath : ctxPath) =
66+
let rec ctxPathToString (ctxPath : ctxPath) =
6567
match ctxPath with
6668
| CId (prefix, typ) ->
6769
Printf.sprintf "CId(%s)=%s"
@@ -73,16 +75,18 @@ let ctxPathToString (ctxPath : ctxPath) =
7375
(ident prefix)
7476
| CVariantPayload {itemNum} -> Printf.sprintf "CVariantPayload($%i)" itemNum
7577
| CRecordField {prefix} -> Printf.sprintf "CRecordField=%s" prefix
78+
| COption ctxPath -> Printf.sprintf "COption<%s>" (ctxPathToString ctxPath)
79+
| CArray ctxPath ->
80+
Printf.sprintf "CArray%s"
81+
(match ctxPath with
82+
| None -> ""
83+
| Some ctxPath -> "[" ^ ctxPathToString ctxPath ^ "]")
7684

77-
type currentlyExpecting = Type of Parsetree.core_type
85+
type currentlyExpecting = Type of ctxPath
7886

79-
type completionTypes =
80-
| CId of string list * completionCategory
81-
| CType of {
82-
pathToType: Parsetree.core_type;
83-
prefix: string; (** What is already written, if anything *)
84-
}
85-
| CtxPath of ctxPath list
87+
let currentlyExpectingToString (c : currentlyExpecting) =
88+
match c with
89+
| Type ctxPath -> Printf.sprintf "Type<%s>" (ctxPathToString ctxPath)
8690

8791
type completionContext = {
8892
positionContext: PositionContext.t;
@@ -91,20 +95,7 @@ type completionContext = {
9195
ctxPath: ctxPath list;
9296
}
9397

94-
type completionResult = (completionTypes * completionContext) option
95-
96-
let findCurrentlyLookingForInPattern (pat : Parsetree.pattern) =
97-
match pat.ppat_desc with
98-
| Ppat_constraint (_pat, typ) -> Some (Type typ)
99-
| _ -> None
100-
101-
let mergeCurrentlyLookingFor (currentlyExpecting : currentlyExpecting option)
102-
list =
103-
match currentlyExpecting with
104-
| None -> list
105-
| Some currentlyExpecting -> currentlyExpecting :: list
106-
107-
let contextWithNewScope scope context = {context with scope}
98+
type completionResult = (ctxPath list * completionContext) option
10899

109100
let flattenLidCheckDot ?(jsx = true) ~(completionContext : completionContext)
110101
(lid : Longident.t Location.loc) =
@@ -122,6 +113,36 @@ let flattenLidCheckDot ?(jsx = true) ~(completionContext : completionContext)
122113
in
123114
Utils.flattenLongIdent ~cutAtOffset ~jsx lid.txt
124115

116+
let rec ctxPathFromCoreType ~completionContext (coreType : Parsetree.core_type)
117+
=
118+
match coreType.ptyp_desc with
119+
| Ptyp_constr ({txt = Lident "option"}, [innerTyp]) ->
120+
innerTyp
121+
|> ctxPathFromCoreType ~completionContext
122+
|> Option.map (fun innerTyp -> COption innerTyp)
123+
| Ptyp_constr ({txt = Lident "array"}, [innerTyp]) ->
124+
Some (CArray (innerTyp |> ctxPathFromCoreType ~completionContext))
125+
| Ptyp_constr (lid, _) ->
126+
Some (CId (lid |> flattenLidCheckDot ~completionContext, Type))
127+
| _ -> None
128+
129+
let findCurrentlyLookingForInPattern ~completionContext
130+
(pat : Parsetree.pattern) =
131+
match pat.ppat_desc with
132+
| Ppat_constraint (_pat, typ) -> (
133+
match ctxPathFromCoreType ~completionContext typ with
134+
| None -> None
135+
| Some ctxPath -> Some (Type ctxPath))
136+
| _ -> None
137+
138+
let mergeCurrentlyLookingFor (currentlyExpecting : currentlyExpecting option)
139+
list =
140+
match currentlyExpecting with
141+
| None -> list
142+
| Some currentlyExpecting -> currentlyExpecting :: list
143+
144+
let contextWithNewScope scope context = {context with scope}
145+
125146
(** Scopes *)
126147
let rec scopePattern ~scope (pat : Parsetree.pattern) =
127148
match pat.ppat_desc with
@@ -250,7 +271,9 @@ and completeValueBinding ~completionContext (vb : Parsetree.value_binding) :
250271
= HasCursor
251272
then (
252273
print_endline "completing expression";
253-
let currentlyExpecting = findCurrentlyLookingForInPattern vb.pvb_pat in
274+
let currentlyExpecting =
275+
findCurrentlyLookingForInPattern ~completionContext vb.pvb_pat
276+
in
254277
completeExpr
255278
~completionContext:
256279
{
@@ -271,11 +294,7 @@ and completeExpr ~completionContext (expr : Parsetree.expression) :
271294
~pos:completionContext.positionContext.beforeCursor
272295
in
273296
match expr.pexp_desc with
274-
| Pexp_ident lid ->
275-
(* An identifier, like `aaa` *)
276-
let lidPath = flattenLidCheckDot lid ~completionContext in
277-
if lid.loc |> locHasPos then Some (CId (lidPath, Value), completionContext)
278-
else None
297+
(* == VARIANTS == *)
279298
| Pexp_construct (_id, Some {pexp_desc = Pexp_tuple args; pexp_loc})
280299
when pexp_loc |> locHasPos ->
281300
(* A constructor with multiple payloads, like: `Co(true, false)` or `Somepath.Co(false, true)` *)
@@ -302,56 +321,105 @@ and completeExpr ~completionContext (expr : Parsetree.expression) :
302321
| Pexp_construct ({txt = Lident txt; loc}, _) when loc |> locHasPos -> (
303322
(* A constructor, like: `Co` *)
304323
match completionContext.currentlyExpecting with
305-
| _ -> Some (CId ([txt], Module), completionContext))
324+
| _ ->
325+
Some (CId ([txt], Module) :: completionContext.ctxPath, completionContext)
326+
)
306327
| Pexp_construct (id, _) when id.loc |> locHasPos ->
307328
(* A path, like: `Something.Co` *)
308329
let lid = flattenLidCheckDot ~completionContext id in
309-
Some (CId (lid, Module), completionContext)
330+
Some (CId (lid, Module) :: completionContext.ctxPath, completionContext)
331+
(* == RECORDS == *)
332+
| Pexp_ident {txt = Lident prefix} when Utils.hasBraces expr.pexp_attributes
333+
->
334+
(* An ident with braces attribute corresponds to for example `{n}`.
335+
Looks like a record but is parsed as an ident with braces. *)
336+
let prefix = if prefix = "()" then "" else prefix in
337+
Some
338+
( CRecordField {prefix; seenFields = []} :: completionContext.ctxPath,
339+
completionContext (* TODO: This isn't correct *) )
310340
| Pexp_record ([], _) when expr.pexp_loc |> locHasPos ->
311341
(* No fields means we're in a record body `{}` *)
312342
Some
313-
( CtxPath
314-
(CRecordField {prefix = ""; seenFields = []}
315-
:: completionContext.ctxPath),
343+
( CRecordField {prefix = ""; seenFields = []} :: completionContext.ctxPath,
316344
completionContext (* TODO: This isn't correct *) )
317-
| Pexp_record (fields, _) when expr.pexp_loc |> locHasPos ->
345+
| Pexp_record (fields, _) when expr.pexp_loc |> locHasPos -> (
318346
(* A record with fields *)
319347
let seenFields =
320348
fields
321349
|> List.map (fun (fieldName, _f) -> Longident.last fieldName.Location.txt)
322350
in
323-
fields
324-
|> Utils.findMap
325-
(fun
326-
((fieldName, fieldExpr) :
327-
Longident.t Location.loc * Parsetree.expression)
328-
->
329-
(* Complete regular idents *)
330-
if locHasPos fieldName.loc then
331-
(* Cursor in field name, complete here *)
332-
match fieldName with
333-
| {txt = Lident prefix} ->
334-
Some
335-
( CtxPath
336-
(CRecordField {prefix; seenFields}
337-
:: completionContext.ctxPath),
338-
completionContext (* TODO: This isn't correct *) )
339-
| fieldName ->
340-
Some
341-
( CId (flattenLidCheckDot ~completionContext fieldName, Value),
342-
completionContext )
343-
else if locHasPos fieldExpr.pexp_loc then
344-
completeExpr
345-
~completionContext:
346-
{
347-
completionContext with
348-
ctxPath =
349-
CRecordField
350-
{prefix = fieldName.txt |> Longident.last; seenFields}
351-
:: completionContext.ctxPath;
352-
}
353-
fieldExpr
354-
else None)
351+
let fieldToComplete =
352+
fields
353+
|> Utils.findMap
354+
(fun
355+
((fieldName, fieldExpr) :
356+
Longident.t Location.loc * Parsetree.expression)
357+
->
358+
(* Complete regular idents *)
359+
if locHasPos fieldName.loc then
360+
(* Cursor in field name, complete here *)
361+
match fieldName with
362+
| {txt = Lident prefix} ->
363+
Some
364+
( CRecordField {prefix; seenFields}
365+
:: completionContext.ctxPath,
366+
completionContext (* TODO: This isn't correct *) )
367+
| fieldName ->
368+
Some
369+
( CId (flattenLidCheckDot ~completionContext fieldName, Value)
370+
:: completionContext.ctxPath,
371+
completionContext )
372+
else if locHasPos fieldExpr.pexp_loc then
373+
completeExpr
374+
~completionContext:
375+
{
376+
completionContext with
377+
ctxPath =
378+
CRecordField
379+
{prefix = fieldName.txt |> Longident.last; seenFields}
380+
:: completionContext.ctxPath;
381+
}
382+
fieldExpr
383+
else None)
384+
in
385+
match fieldToComplete with
386+
| None -> (
387+
(* Check if there's a expr hole with an empty cursor for a field. This means completing for an empty field `{someField: <com>}`. *)
388+
let fieldNameWithExprHole =
389+
fields
390+
|> Utils.findMap (fun (fieldName, fieldExpr) ->
391+
if
392+
CompletionExpressions.isExprHole fieldExpr
393+
&& CursorPosition.classifyLoc fieldExpr.pexp_loc
394+
~pos:completionContext.positionContext.beforeCursor
395+
= EmptyLoc
396+
then Some (Longident.last fieldName.Location.txt)
397+
else None)
398+
in
399+
(* We found no field to complete, but we know the cursor is inside this record body.
400+
Check if the char to the left of the cursor is ',', if so, complete for record fields.*)
401+
match
402+
( fieldNameWithExprHole,
403+
completionContext.positionContext.charBeforeNoWhitespace )
404+
with
405+
| Some fieldName, _ ->
406+
Some
407+
( CRecordField {prefix = fieldName; seenFields}
408+
:: completionContext.ctxPath,
409+
completionContext (* TODO: This isn't correct *) )
410+
| None, Some ',' ->
411+
Some
412+
( CRecordField {prefix = ""; seenFields} :: completionContext.ctxPath,
413+
completionContext (* TODO: This isn't correct *) )
414+
| _ -> None)
415+
| fieldToComplete -> fieldToComplete)
416+
(* == IDENTS == *)
417+
| Pexp_ident lid ->
418+
(* An identifier, like `aaa` *)
419+
let lidPath = flattenLidCheckDot lid ~completionContext in
420+
if lid.loc |> locHasPos then
421+
Some (CId (lidPath, Value) :: completionContext.ctxPath, completionContext)
422+
else None
355423
| Pexp_match _ | Pexp_unreachable | Pexp_constant _
356424
| Pexp_let (_, _, _)
357425
| Pexp_function _
@@ -372,19 +440,18 @@ and completeExpr ~completionContext (expr : Parsetree.expression) :
372440
| Pexp_constraint (_, _)
373441
| Pexp_coerce (_, _, _)
374442
| Pexp_send (_, _)
375-
| Pexp_new _
376443
| Pexp_setinstvar (_, _)
377444
| Pexp_override _
378445
| Pexp_letmodule (_, _, _)
379446
| Pexp_letexception (_, _)
380447
| Pexp_assert _ | Pexp_lazy _
381448
| Pexp_poly (_, _)
382-
| Pexp_object _
383449
| Pexp_newtype (_, _)
384450
| Pexp_pack _
385451
| Pexp_open (_, _, _)
386452
| Pexp_extension _ ->
387453
None
454+
| Pexp_object _ | Pexp_new _ -> (* These are irrelevant to ReScript *) None
388455

389456
let completion ~currentFile ~path ~debug ~offset ~posCursor text =
390457
let positionContext = PositionContext.make ~offset ~posCursor text in

‎analysis/src/Completions.ml

+9-13
Original file line numberDiff line numberDiff line change
@@ -34,18 +34,14 @@ let getCompletions2 ~debug ~path ~pos ~currentFile ~forHover =
3434
~currentFile text
3535
with
3636
| None -> print_endline "No completions"
37-
| Some (res, ctx) ->
37+
| Some (ctxPath, ctx) ->
3838
Printf.printf "Result: %s\n"
39-
(match res with
40-
| CId (path, _ctx) -> "CId " ^ SharedTypes.ident path
41-
| CtxPath ctxPath ->
42-
"CtxPath: "
43-
^ (ctxPath |> List.rev
44-
|> List.map CompletionFrontEndNew.ctxPathToString
45-
|> String.concat "->")
46-
| CType {prefix} -> "CType:<todo-typ> =" ^ prefix);
47-
Printf.printf "Scope: %i items\n" (List.length ctx.scope);
48-
Printf.printf "CtxPath: %s\n"
49-
(ctx.ctxPath |> List.rev
39+
(ctxPath |> List.rev
5040
|> List.map CompletionFrontEndNew.ctxPathToString
51-
|> String.concat "->")))
41+
|> String.concat "->");
42+
Printf.printf "Scope: %i items\n" (List.length ctx.scope);
43+
Printf.printf "Looking for type: %s\n"
44+
(match ctx.currentlyExpecting with
45+
| currentlyExpecting :: _ ->
46+
CompletionFrontEndNew.currentlyExpectingToString currentlyExpecting
47+
| _ -> "")))

‎analysis/tests/src/CompletionNew.res

+12-2
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ type rec someVariant = One | Two | Three(bool, option<someVariant>)
2020
type nestedRecord = {
2121
on: bool,
2222
off?: bool,
23+
maybeVariant?: someVariant,
2324
}
2425

2526
type someRecord = {nested: option<nestedRecord>, variant: someVariant}
@@ -33,5 +34,14 @@ type someRecord = {nested: option<nestedRecord>, variant: someVariant}
3334
// let myFunc: someRecord = {variant: O}
3435
// ^co2
3536

36-
// let myFunc: someRecord = {nested: {}}
37-
// ^co2
37+
// let myFunc: someRecord = {nested: {maybeVariant: Three(false, t)}}
38+
// ^co2
39+
40+
// let myFunc: someRecord = {nested: {maybeVariant: One}, variant: }
41+
// ^co2
42+
43+
// let myFunc: someRecord = {nested: {maybeVariant: One, }}
44+
// ^co2
45+
46+
// let myFunc: someRecord = {nested: {maybeVariant: One}, }
47+
// ^co2

0 commit comments

Comments
 (0)