Skip to content

Commit d7910e9

Browse files
zthzth
committed
refactor
1 parent 11c61e8 commit d7910e9

File tree

2 files changed

+67
-47
lines changed

2 files changed

+67
-47
lines changed

‎analysis/src/CompletionFrontEndNew.ml

Lines changed: 61 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -99,6 +99,20 @@ let rec ctxPathToString (ctxPath : ctxPath) =
9999
| None -> ""
100100
| Some ctxPath -> "[" ^ ctxPathToString ctxPath ^ "]")
101101

102+
module CompletionInstruction = struct
103+
(** This is the completion instruction, that's responsible for resolving something at
104+
context path X *)
105+
type t = CtxPath of ctxPath list
106+
107+
let ctxPath ctxPath = CtxPath ctxPath
108+
109+
let toString (c : t) =
110+
match c with
111+
| CtxPath ctxPath ->
112+
Printf.sprintf "CtxPath: %s"
113+
(ctxPath |> List.map ctxPathToString |> String.concat "->")
114+
end
115+
102116
type currentlyExpecting =
103117
| Unit
104118
| Type of ctxPath
@@ -141,9 +155,22 @@ module CompletionContext = struct
141155

142156
let withResetCurrentlyExpecting completionContext =
143157
{completionContext with currentlyExpecting = [Unit]}
158+
159+
let addCtxPathItem ctxPath completionContext =
160+
{completionContext with ctxPath = ctxPath :: completionContext.ctxPath}
144161
end
145162

146-
type completionResult = (ctxPath list * CompletionContext.t) option
163+
module CompletionResult = struct
164+
type t = (CompletionInstruction.t * CompletionContext.t) option
165+
166+
let ctxPath (ctxPath : ctxPath) (completionContext : CompletionContext.t) =
167+
let completionContext =
168+
completionContext |> CompletionContext.addCtxPathItem ctxPath
169+
in
170+
Some
171+
( CompletionInstruction.ctxPath completionContext.ctxPath,
172+
completionContext )
173+
end
147174

148175
let flattenLidCheckDot ?(jsx = true) ~(completionContext : CompletionContext.t)
149176
(lid : Longident.t Location.loc) =
@@ -292,14 +319,14 @@ let scopeModuleDeclaration ~scope (md : Parsetree.module_declaration) =
292319
scope |> Scope.addModule ~name:md.pmd_name.txt ~loc:md.pmd_name.loc
293320

294321
let rec completeFromStructure ~completionContext
295-
(structure : Parsetree.structure) : completionResult =
322+
(structure : Parsetree.structure) : CompletionResult.t =
296323
(* TODO: Scope? *)
297324
structure
298325
|> Utils.findMap (fun (item : Parsetree.structure_item) ->
299326
completeStructureItem ~completionContext item)
300327

301328
and completeStructureItem ~(completionContext : CompletionContext.t)
302-
(item : Parsetree.structure_item) : completionResult =
329+
(item : Parsetree.structure_item) : CompletionResult.t =
303330
match item.pstr_desc with
304331
| Pstr_value (recFlag, valueBindings) ->
305332
let scopeFromBindings =
@@ -334,7 +361,7 @@ and completeStructureItem ~(completionContext : CompletionContext.t)
334361
(* These aren't relevant for ReScript *) None
335362

336363
and completeValueBinding ~completionContext (vb : Parsetree.value_binding) :
337-
completionResult =
364+
CompletionResult.t =
338365
let scopeWithPattern =
339366
scopePattern ~scope:completionContext.scope vb.pvb_pat
340367
in
@@ -368,7 +395,7 @@ and completeValueBinding ~completionContext (vb : Parsetree.value_binding) :
368395
else None
369396

370397
and completeExpr ~completionContext (expr : Parsetree.expression) :
371-
completionResult =
398+
CompletionResult.t =
372399
let locHasPos loc =
373400
loc
374401
|> CursorPosition.locHasCursor
@@ -399,30 +426,27 @@ and completeExpr ~completionContext (expr : Parsetree.expression) :
399426
ctxPath = CVariantPayload {itemNum = 0} :: completionContext.ctxPath;
400427
}
401428
payloadExpr
402-
| Pexp_construct ({txt = Lident txt; loc}, _) when loc |> locHasPos -> (
429+
| Pexp_construct ({txt = Lident txt; loc}, _) when loc |> locHasPos ->
403430
(* A constructor, like: `Co` *)
404-
match completionContext.currentlyExpecting with
405-
| _ ->
406-
Some (CId ([txt], Module) :: completionContext.ctxPath, completionContext)
407-
)
431+
CompletionResult.ctxPath (CId ([txt], Module)) completionContext
408432
| Pexp_construct (id, _) when id.loc |> locHasPos ->
409433
(* A path, like: `Something.Co` *)
410434
let lid = flattenLidCheckDot ~completionContext id in
411-
Some (CId (lid, Module) :: completionContext.ctxPath, completionContext)
435+
CompletionResult.ctxPath (CId (lid, Module)) completionContext
412436
(* == RECORDS == *)
413437
| Pexp_ident {txt = Lident prefix} when Utils.hasBraces expr.pexp_attributes
414438
->
415439
(* An ident with braces attribute corresponds to for example `{n}`.
416440
Looks like a record but is parsed as an ident with braces. *)
417441
let prefix = if prefix = "()" then "" else prefix in
418-
Some
419-
( CRecordField {prefix; seenFields = []} :: completionContext.ctxPath,
420-
completionContext (* TODO: This isn't correct *) )
442+
CompletionResult.ctxPath
443+
(CRecordField {prefix; seenFields = []})
444+
completionContext
421445
| Pexp_record ([], _) when expr.pexp_loc |> locHasPos ->
422446
(* No fields means we're in a record body `{}` *)
423-
Some
424-
( CRecordField {prefix = ""; seenFields = []} :: completionContext.ctxPath,
425-
completionContext (* TODO: This isn't correct *) )
447+
CompletionResult.ctxPath
448+
(CRecordField {prefix = ""; seenFields = []})
449+
completionContext
426450
| Pexp_record (fields, _) when expr.pexp_loc |> locHasPos -> (
427451
(* A record with fields *)
428452
let seenFields =
@@ -441,25 +465,20 @@ and completeExpr ~completionContext (expr : Parsetree.expression) :
441465
(* Cursor in field name, complete here *)
442466
match fieldName with
443467
| {txt = Lident prefix} ->
444-
Some
445-
( CRecordField {prefix; seenFields}
446-
:: completionContext.ctxPath,
447-
completionContext (* TODO: This isn't correct *) )
468+
CompletionResult.ctxPath
469+
(CRecordField {prefix; seenFields})
470+
completionContext
448471
| fieldName ->
449-
Some
450-
( CId (flattenLidCheckDot ~completionContext fieldName, Value)
451-
:: completionContext.ctxPath,
452-
completionContext )
472+
CompletionResult.ctxPath
473+
(CId (flattenLidCheckDot ~completionContext fieldName, Value))
474+
completionContext
453475
else if locHasPos fieldExpr.pexp_loc then
454476
completeExpr
455477
~completionContext:
456-
{
457-
completionContext with
458-
ctxPath =
459-
CRecordField
460-
{prefix = fieldName.txt |> Longident.last; seenFields}
461-
:: completionContext.ctxPath;
462-
}
478+
(CompletionContext.addCtxPathItem
479+
(CRecordField
480+
{prefix = fieldName.txt |> Longident.last; seenFields})
481+
completionContext)
463482
fieldExpr
464483
else None)
465484
in
@@ -485,22 +504,21 @@ and completeExpr ~completionContext (expr : Parsetree.expression) :
485504
completionContext.positionContext.charBeforeNoWhitespace )
486505
with
487506
| Some fieldName, _ ->
488-
Some
489-
( CRecordField {prefix = fieldName; seenFields}
490-
:: completionContext.ctxPath,
491-
completionContext (* TODO: This isn't correct *) )
507+
CompletionResult.ctxPath
508+
(CRecordField {prefix = fieldName; seenFields})
509+
completionContext
492510
| None, Some ',' ->
493-
Some
494-
( CRecordField {prefix = ""; seenFields} :: completionContext.ctxPath,
495-
completionContext (* TODO: This isn't correct *) )
511+
CompletionResult.ctxPath
512+
(CRecordField {prefix = ""; seenFields})
513+
completionContext
496514
| _ -> None)
497515
| fieldToComplete -> fieldToComplete)
498516
(* == IDENTS == *)
499517
| Pexp_ident lid ->
500518
(* An identifier, like `aaa` *)
501519
let lidPath = flattenLidCheckDot lid ~completionContext in
502520
if lid.loc |> locHasPos then
503-
Some (CId (lidPath, Value) :: completionContext.ctxPath, completionContext)
521+
CompletionResult.ctxPath (CId (lidPath, Value)) completionContext
504522
else None
505523
| Pexp_let (_recFlag, _valueBindings, nextExpr) ->
506524
(* A let binding. `let a = b` *)
@@ -519,12 +537,12 @@ and completeExpr ~completionContext (expr : Parsetree.expression) :
519537
| Some else_ ->
520538
if locHasPos else_.pexp_loc then completeExpr ~completionContext else_
521539
else if checkIfExprHoleEmptyCursor ~completionContext else_ then
522-
Some (CId ([], Value) :: completionContext.ctxPath, completionContext)
540+
CompletionResult.ctxPath (CId ([], Value)) completionContext
523541
else None
524542
| _ ->
525543
(* Check then_ too *)
526544
if checkIfExprHoleEmptyCursor ~completionContext then_ then
527-
Some (CId ([], Value) :: completionContext.ctxPath, completionContext)
545+
CompletionResult.ctxPath (CId ([], Value)) completionContext
528546
else None)
529547
| Pexp_sequence (evalExpr, nextExpr) ->
530548
if locHasPos evalExpr.pexp_loc then
@@ -578,7 +596,7 @@ and completeExpr ~completionContext (expr : Parsetree.expression) :
578596
in
579597
if locHasPos expr.pexp_loc then completeExpr ~completionContext expr
580598
else if checkIfExprHoleEmptyCursor ~completionContext expr then
581-
Some (CId ([], Value) :: completionContext.ctxPath, completionContext)
599+
CompletionResult.ctxPath (CId ([], Value)) completionContext
582600
else None
583601
| Pexp_match _ | Pexp_unreachable | Pexp_constant _ | Pexp_function _
584602
| Pexp_try (_, _)

‎analysis/src/Completions.ml

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -34,11 +34,13 @@ let getCompletions2 ~debug ~path ~pos ~currentFile ~forHover =
3434
~currentFile text
3535
with
3636
| None -> print_endline "No completions"
37-
| Some (ctxPath, ctx) ->
37+
| Some (res, ctx) ->
3838
Printf.printf "Result: %s\n"
39-
(ctxPath |> List.rev
40-
|> List.map CompletionFrontEndNew.ctxPathToString
41-
|> String.concat "->");
39+
(match res with
40+
| CtxPath ctxPath ->
41+
ctxPath |> List.rev
42+
|> List.map CompletionFrontEndNew.ctxPathToString
43+
|> String.concat "->");
4244
Printf.printf "Scope: %i items\n" (List.length ctx.scope);
4345
Printf.printf "Looking for type: %s\n"
4446
(match ctx.currentlyExpecting with

0 commit comments

Comments
 (0)