From 1ecd9bd12d557a5b7a41eed93ddc53c04d582111 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 15 Jul 2022 22:38:55 +0200 Subject: [PATCH] basic completion for regular (payload-less) variant constructors in labelled arguments --- analysis/src/CompletionBackEnd.ml | 64 ++++++++++++++- analysis/src/CompletionFrontEnd.ml | 2 +- analysis/src/SharedTypes.ml | 16 +++- analysis/tests/src/TypeContextCompletion.res | 18 ++--- .../expected/TypeContextCompletion.res.txt | 81 +++++++++++++++---- server/src/server.ts | 4 +- 6 files changed, 157 insertions(+), 28 deletions(-) diff --git a/analysis/src/CompletionBackEnd.ml b/analysis/src/CompletionBackEnd.ml index bed40cf75..8ee7e0593 100644 --- a/analysis/src/CompletionBackEnd.ml +++ b/analysis/src/CompletionBackEnd.ml @@ -992,6 +992,18 @@ let rec extractRecordType ~env ~package (t : Types.type_expr) = | _ -> None) | _ -> None +let rec extractVariantType ~env ~package (t : Types.type_expr) = + match t.desc with + | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractVariantType ~env ~package t1 + | Tconstr (path, _, _) -> ( + match References.digConstructor ~env ~package path with + | Some (env, ({item = {kind = Variant constructors}} as typ)) -> + Some (env, constructors, typ) + | Some (env, {item = {decl = {type_manifest = Some t1}}}) -> + extractVariantType ~env ~package t1 + | _ -> None) + | _ -> None + let rec extractObjectType ~env ~package (t : Types.type_expr) = match t.desc with | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractObjectType ~env ~package t1 @@ -1337,7 +1349,6 @@ let processCompletable ~debug ~package ~scope ~env ~pos ~forHover in match completable with | Cnone -> [] - | CtypedContext _contextPath -> [] | Cpath contextPath -> contextPath |> getCompletionsForContextPath ~package ~opens ~rawOpens ~allFiles ~pos @@ -1687,3 +1698,54 @@ Note: The `@react.component` decorator requires the react-jsx config to be set i Utils.startsWith name prefix && (forHover || not (List.mem name identsSeen))) |> List.map mkLabel + | CtypedContext (cp, typedContext) -> ( + match typedContext with + | NamedArg argName -> ( + (* TODO: Should probably share this with the branch handling CnamedArg... *) + let labels = + match + cp + |> getCompletionsForContextPath ~package ~opens ~rawOpens ~allFiles + ~pos ~env ~exact:true ~scope + |> completionsGetTypeEnv + with + | Some (typ, _env) -> + let rec getLabels ~env (t : Types.type_expr) = + match t.desc with + | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> getLabels ~env t1 + | Tarrow ((Labelled l | Optional l), tArg, tRet, _) -> + (l, tArg) :: getLabels ~env tRet + | Tarrow (Nolabel, _, tRet, _) -> getLabels ~env tRet + | Tconstr (path, _, _) -> ( + match References.digConstructor ~env ~package path with + | Some (env, {item = {decl = {type_manifest = Some t1}}}) -> + getLabels ~env t1 + | _ -> []) + | _ -> [] + in + typ |> getLabels ~env + | None -> [] + in + let targetLabel = + labels |> List.find_opt (fun (name, _t) -> name = argName) + in + match targetLabel with + | None -> [] + | Some (_, typeExpr) -> ( + match extractVariantType ~env ~package typeExpr with + | None -> + if debug then Printf.printf "Could not extract variant type\n"; + [] + | Some (_env, constructors, _typ) -> + if debug then + Printf.printf "Found variant type for NamedArg typed context %s\n" + (typeExpr |> Shared.typeToString); + constructors + |> List.filter (fun constructor -> + (* This currently omits any constructor with a payload. Probably don't want to emit them. Maybe we can just move the cursor inside of the payload and continue from there.*) + (* TODO: Account for existing prefix (e.g what the user has already started typing, if anything) *) + constructor.Constructor.args |> List.length = 0) + |> List.map (fun constructor -> + Completion.create ~name:constructor.Constructor.cname.txt + ~kind:(Constructor (constructor, "")) + ~env)))) diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml index ab8cb1d5b..92aa61df2 100644 --- a/analysis/src/CompletionFrontEnd.ml +++ b/analysis/src/CompletionFrontEnd.ml @@ -162,7 +162,7 @@ let findNamedArgCompletable ~(args : arg list) ~endPos ~posBeforeCursor || charBeforeCursor = Some '=' then ( if debug then Printf.printf "found typed context \n"; - Some (Completable.CtypedContext contextPath)) + Some (Completable.CtypedContext (contextPath, NamedArg labelled.name))) else loop rest | {label = None; exp} :: rest -> if exp.pexp_loc |> Loc.hasPos ~pos:posBeforeCursor then None diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml index 53cd2e10b..f73c2d8ff 100644 --- a/analysis/src/SharedTypes.ml +++ b/analysis/src/SharedTypes.ml @@ -425,6 +425,12 @@ module Completable = struct | CPObj of contextPath * string | CPPipe of contextPath * string + type typedContext = NamedArg of string + + let typedContextToString typedContext = + match typedContext with + | NamedArg argName -> "NamedArg(" ^ argName ^ ")" + type t = | Cdecorator of string (** e.g. @module *) | CnamedArg of contextPath * string * string list @@ -433,7 +439,8 @@ module Completable = struct | Cpath of contextPath | Cjsx of string list * string * string list (** E.g. (["M", "Comp"], "id", ["id1", "id2"]) for "Cnone" | Cjsx (sl1, s, sl2) -> "Cjsx(" ^ (sl1 |> list) ^ ", " ^ str s ^ ", " ^ (sl2 |> list) ^ ")" - | CtypedContext cp -> "CtypedContext(" ^ (cp |> contextPathToString) ^ ")" + | CtypedContext (cp, typedContext) -> + "CtypedContext(" + ^ (cp |> contextPathToString) + ^ ", " + ^ (typedContext |> typedContextToString) + ^ ")" end diff --git a/analysis/tests/src/TypeContextCompletion.res b/analysis/tests/src/TypeContextCompletion.res index 632d9a51e..0be719066 100644 --- a/analysis/tests/src/TypeContextCompletion.res +++ b/analysis/tests/src/TypeContextCompletion.res @@ -1,26 +1,26 @@ type someVariant = One | Two | Three | Four -let someVariantToString = (~someVariant) => - switch someVariant { - | One => "One" +let someVariantToString = (~someConfig, ~otherRandomArg) => + switch someConfig { + | One => "One " ++ otherRandomArg | Two => "Two" | Three => "Three" | Four => "Four" } -// let x = someVariantToString(~someVaria +// let x = someVariantToString(~someConfi // ^com -// let x = someVariantToString(~someVariant= -// ^com +// let x = someVariantToString(~someConfig= +// ^com -// let x = someVariantToString(~someVariant=T -// ^com +// let x = someVariantToString(~someConfig=T +// ^com module SomeComponent = { @react.component let make = (~whatever) => { - someVariantToString(~someVariant=whatever)->React.string + someVariantToString(~someConfig=whatever, ~otherRandomArg="123")->React.string } } diff --git a/analysis/tests/src/expected/TypeContextCompletion.res.txt b/analysis/tests/src/expected/TypeContextCompletion.res.txt index b24dbe969..64310f6da 100644 --- a/analysis/tests/src/expected/TypeContextCompletion.res.txt +++ b/analysis/tests/src/expected/TypeContextCompletion.res.txt @@ -1,29 +1,82 @@ Complete src/TypeContextCompletion.res 10:41 posCursor:[10:41] posNoWhite:[10:40] Found expr:[10:11->24:1] -Pexp_apply ...[10:11->10:30] (~someVaria10:32->10:41=...[10:32->10:41], ...[19:0->23:3]) -Completable: CnamedArg(Value[someVariantToString], someVaria, [someVaria]) -Found type for function (~someVariant: someVariant) => string +Pexp_apply ...[10:11->10:30] (~someConfi10:32->10:41=...[10:32->10:41], ...[19:0->23:3]) +Completable: CnamedArg(Value[someVariantToString], someConfi, [someConfi]) +Found type for function ( + ~someConfig: someVariant, + ~otherRandomArg: string, +) => string [{ - "label": "someVariant", + "label": "someConfig", "kind": 4, "tags": [], "detail": "someVariant", "documentation": null }] -Complete src/TypeContextCompletion.res 13:44 -posCursor:[13:44] posNoWhite:[13:43] Found expr:[13:11->24:1] -Pexp_apply ...[13:11->13:30] (~someVariant13:32->13:43=...[19:0->23:3]) +Complete src/TypeContextCompletion.res 13:43 +posCursor:[13:43] posNoWhite:[13:42] Found expr:[13:11->24:1] +Pexp_apply ...[13:11->13:30] (~someConfig13:32->13:42=...[19:0->23:3]) found typed context -Completable: CtypedContext(Value[someVariantToString]) -[] +Completable: CtypedContext(Value[someVariantToString], NamedArg(someConfig)) +Found variant type for NamedArg typed context someVariant +[{ + "label": "One", + "kind": 4, + "tags": [], + "detail": "One\n\n", + "documentation": null + }, { + "label": "Two", + "kind": 4, + "tags": [], + "detail": "Two\n\n", + "documentation": null + }, { + "label": "Three", + "kind": 4, + "tags": [], + "detail": "Three\n\n", + "documentation": null + }, { + "label": "Four", + "kind": 4, + "tags": [], + "detail": "Four\n\n", + "documentation": null + }] -Complete src/TypeContextCompletion.res 16:45 -posCursor:[16:45] posNoWhite:[16:44] Found expr:[16:11->24:1] -Pexp_apply ...[16:11->16:30] (~someVariant16:32->16:43=...[16:44->16:45], ...[19:0->23:3]) +Complete src/TypeContextCompletion.res 16:44 +posCursor:[16:44] posNoWhite:[16:43] Found expr:[16:11->24:1] +Pexp_apply ...[16:11->16:30] (~someConfig16:32->16:42=...[16:43->16:44], ...[19:0->23:3]) found typed context -Completable: CtypedContext(Value[someVariantToString]) -[] +Completable: CtypedContext(Value[someVariantToString], NamedArg(someConfig)) +Found variant type for NamedArg typed context someVariant +[{ + "label": "One", + "kind": 4, + "tags": [], + "detail": "One\n\n", + "documentation": null + }, { + "label": "Two", + "kind": 4, + "tags": [], + "detail": "Two\n\n", + "documentation": null + }, { + "label": "Three", + "kind": 4, + "tags": [], + "detail": "Three\n\n", + "documentation": null + }, { + "label": "Four", + "kind": 4, + "tags": [], + "detail": "Four\n\n", + "documentation": null + }] Complete src/TypeContextCompletion.res 26:37 posCursor:[26:37] posNoWhite:[26:36] Found expr:[26:14->26:37] diff --git a/server/src/server.ts b/server/src/server.ts index b82a799ee..01cbae3be 100644 --- a/server/src/server.ts +++ b/server/src/server.ts @@ -918,7 +918,9 @@ function onMessage(msg: p.Message) { codeActionProvider: true, renameProvider: { prepareProvider: true }, documentSymbolProvider: true, - completionProvider: { triggerCharacters: [".", ">", "@", "~", '"'] }, + completionProvider: { + triggerCharacters: [".", ">", "@", "~", '"', "="], + }, semanticTokensProvider: { legend: { tokenTypes: [