Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Complete creator/maker functions for type t #884

Merged
merged 2 commits into from
Jan 8, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,7 @@
- Include fields when completing a braced expr that's an ID, where it the path likely starts with a module. https://github.com/rescript-lang/rescript-vscode/pull/882
- Complete domProps for lowercase JSX components from `ReactDOM.domProps` if possible. https://github.com/rescript-lang/rescript-vscode/pull/883
- Do not emit `_` when completing in patterns. https://github.com/rescript-lang/rescript-vscode/pull/885
- Complete for maker-style functions (functions returning type `t` of a module) when encountering a `type t` in relevant scenarios. https://github.com/rescript-lang/rescript-vscode/pull/884

## 1.32.0

Expand Down
166 changes: 98 additions & 68 deletions analysis/src/CompletionBackEnd.ml
Original file line number Diff line number Diff line change
Expand Up @@ -514,7 +514,7 @@ let getComplementaryCompletionsForTypedValue ~opens ~allFiles ~scope ~env prefix
in
localCompletionsWithOpens @ fileModules

let getCompletionsForPath ~debug ~package ~opens ~full ~pos ~exact ~scope
let getCompletionsForPath ~debug ~opens ~full ~pos ~exact ~scope
~completionContext ~env path =
if debug then Printf.printf "Path %s\n" (path |> String.concat ".");
let allFiles = allFilesInPackage full.package in
Expand All @@ -541,7 +541,9 @@ let getCompletionsForPath ~debug ~package ~opens ~full ~pos ~exact ~scope
localCompletionsWithOpens @ fileModules
| moduleName :: path -> (
Log.log ("Path " ^ pathToString path);
match getEnvWithOpens ~scope ~env ~package ~opens ~moduleName path with
match
getEnvWithOpens ~scope ~env ~package:full.package ~opens ~moduleName path
with
| Some (env, prefix) ->
Log.log "Got the env";
let namesUsed = Hashtbl.create 10 in
Expand All @@ -552,8 +554,8 @@ let rec digToRecordFieldsForCompletion ~debug ~package ~opens ~full ~pos ~env
~scope path =
match
path
|> getCompletionsForPath ~debug ~completionContext:Type ~exact:true ~package
~opens ~full ~pos ~env ~scope
|> getCompletionsForPath ~debug ~completionContext:Type ~exact:true ~opens
~full ~pos ~env ~scope
with
| {kind = Type {kind = Abstract (Some (p, _))}} :: _ ->
(* This case happens when what we're looking for is a type alias.
Expand Down Expand Up @@ -769,8 +771,8 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact
| _ -> [])
| CPId (path, completionContext) ->
path
|> getCompletionsForPath ~debug ~package ~opens ~full ~pos ~exact
~completionContext ~env ~scope
|> getCompletionsForPath ~debug ~opens ~full ~pos ~exact ~completionContext
~env ~scope
| CPApply (cp, labels) -> (
match
cp
Expand Down Expand Up @@ -815,7 +817,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact
| CPField (CPId (path, Module), fieldName) ->
(* M.field *)
path @ [fieldName]
|> getCompletionsForPath ~debug ~package ~opens ~full ~pos ~exact
|> getCompletionsForPath ~debug ~opens ~full ~pos ~exact
~completionContext:Field ~env ~scope
| CPField (cp, fieldName) -> (
let completionsForCtxPath =
Expand Down Expand Up @@ -933,52 +935,18 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact
| Tconstr (path, _typeArgs, _)
| Tlink {desc = Tconstr (path, _typeArgs, _)}
| Tsubst {desc = Tconstr (path, _typeArgs, _)}
| Tpoly ({desc = Tconstr (path, _typeArgs, _)}, []) -> (
| Tpoly ({desc = Tconstr (path, _typeArgs, _)}, []) ->
if debug then Printf.printf "CPPipe type path:%s\n" (Path.name path);
match Utils.expandPath path with
| _ :: pathRev ->
(* type path is relative to the completion environment
express it from the root of the file *)
let found, pathFromEnv =
QueryEnv.pathFromEnv envFromCompletionItem (List.rev pathRev)
in
if debug then
Printf.printf "CPPipe pathFromEnv:%s found:%b\n"
(pathFromEnv |> String.concat ".")
found;
if pathFromEnv = [] then None
else if
env.file.moduleName <> envFromCompletionItem.file.moduleName
&& found
(* If the module names are different, then one needs to qualify the path.
But only if the path belongs to the env from completion *)
then Some (envFromCompletionItem.file.moduleName :: pathFromEnv)
else Some pathFromEnv
| _ -> None)
TypeUtils.getPathRelativeToEnv ~debug ~env
~envFromItem:envFromCompletionItem (Utils.expandPath path)
| _ -> None)
in
match completionPath with
| Some completionPath -> (
let rec removeRawOpen rawOpen modulePath =
match (rawOpen, modulePath) with
| [_], _ -> Some modulePath
| s :: inner, first :: restPath when s = first ->
removeRawOpen inner restPath
| _ -> None
in
let rec removeRawOpens rawOpens modulePath =
match rawOpens with
| rawOpen :: restOpens -> (
let newModulePath = removeRawOpens restOpens modulePath in
match removeRawOpen rawOpen newModulePath with
| None -> newModulePath
| Some mp -> mp)
| [] -> modulePath
in
let completionPathMinusOpens =
completionPath |> Utils.flattenAnyNamespaceInPath
|> removeRawOpens package.opens
|> removeRawOpens rawOpens |> String.concat "."
TypeUtils.removeOpensFromCompletionPath ~rawOpens ~package
completionPath
|> String.concat "."
in
let completionName name =
if completionPathMinusOpens = "" then name
Expand All @@ -987,7 +955,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact
let completions =
completionPath @ [funNamePrefix]
|> getCompletionsForPath ~debug ~completionContext:Value ~exact:false
~package ~opens ~full ~pos ~env ~scope
~opens ~full ~pos ~env ~scope
in
let completions =
completions
Expand Down Expand Up @@ -1051,7 +1019,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact
let findTypeOfValue path =
path
|> getCompletionsForPath ~debug ~completionContext:Value ~exact:true
~package ~opens ~full ~pos ~env ~scope
~opens ~full ~pos ~env ~scope
|> completionsGetTypeEnv2 ~debug ~full ~opens ~rawOpens ~pos
in
let lowercaseComponent =
Expand All @@ -1061,16 +1029,25 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact
in
let targetLabel =
if lowercaseComponent then
match
["ReactDOM"; "domProps"]
|> digToRecordFieldsForCompletion ~debug ~package ~opens ~full ~pos
~env ~scope
with
| None -> None
| Some fields -> (
match fields |> List.find_opt (fun f -> f.fname.txt = propName) with
| None -> None
| Some f -> Some (f.fname.txt, f.typ, env))
let rec digToTypeForCompletion path =
match
path
|> getCompletionsForPath ~debug ~completionContext:Type ~exact:true
~opens ~full ~pos ~env ~scope
with
| {kind = Type {kind = Abstract (Some (p, _))}} :: _ ->
(* This case happens when what we're looking for is a type alias.
This is the case in newer rescript-react versions where
ReactDOM.domProps is an alias for JsxEvent.t. *)
let pathRev = p |> Utils.expandPath in
pathRev |> List.rev |> digToTypeForCompletion
| {kind = Type {kind = Record fields}} :: _ -> (
match fields |> List.find_opt (fun f -> f.fname.txt = propName) with
| None -> None
| Some f -> Some (f.fname.txt, f.typ, env))
| _ -> None
in
["ReactDOM"; "domProps"] |> digToTypeForCompletion
else
CompletionJsx.getJsxLabels ~componentPath:pathToComponent
~findTypeOfValue ~package
Expand Down Expand Up @@ -1202,14 +1179,67 @@ let printConstructorArgs argsLen ~asSnippet =

type completionMode = Pattern of Completable.patternMode | Expression

let rec completeTypedValue ~full ~prefix ~completionContext ~mode
let rec completeTypedValue ~rawOpens ~full ~prefix ~completionContext ~mode
(t : SharedTypes.completionType) =
let emptyCase num =
match mode with
| Expression -> "$" ^ string_of_int (num - 1)
| Pattern _ -> "${" ^ string_of_int num ^ ":_}"
in
match t with
| TtypeT {env; path} ->
(* Find all functions in the module that returns type t *)
let rec fnReturnsTypeT t =
match t.Types.desc with
| Tlink t1
| Tsubst t1
| Tpoly (t1, [])
| Tconstr (Pident {name = "function$"}, [t1; _], _) ->
fnReturnsTypeT t1
| Tarrow _ -> (
match TypeUtils.extractFunctionType ~env ~package:full.package t with
| ( (Nolabel, {desc = Tconstr (Path.Pident {name = "t"}, _, _)}) :: _,
{desc = Tconstr (Path.Pident {name = "t"}, _, _)} ) ->
(* Filter out functions that take type t first. These are often
@send style functions that we don't want to have here because
they usually aren't meant to create a type t from scratch. *)
false
| _args, {desc = Tconstr (Path.Pident {name = "t"}, _, _)} -> true
| _ -> false)
| _ -> false
in
let functionsReturningTypeT =
Hashtbl.create (Hashtbl.length env.exported.values_)
in
env.exported.values_
|> Hashtbl.iter (fun name stamp ->
match Stamps.findValue env.file.stamps stamp with
| None -> ()
| Some {item} -> (
if fnReturnsTypeT item then
let fnNname =
TypeUtils.getPathRelativeToEnv ~debug:false
~env:(QueryEnv.fromFile full.file)
~envFromItem:env (Utils.expandPath path)
in

match fnNname with
| None -> ()
| Some base ->
let base =
TypeUtils.removeOpensFromCompletionPath ~rawOpens
~package:full.package base
in
Hashtbl.add functionsReturningTypeT
((base |> String.concat ".") ^ "." ^ name)
item));
Hashtbl.fold
(fun fnName typeExpr all ->
Completion.createWithSnippet
~name:(Printf.sprintf "%s()" fnName)
~insertText:(fnName ^ "($0)") ~kind:(Value typeExpr) ~env ()
:: all)
functionsReturningTypeT []
| Tbool env ->
[
Completion.create "true" ~kind:(Label "bool") ~env;
Expand Down Expand Up @@ -1268,7 +1298,7 @@ let rec completeTypedValue ~full ~prefix ~completionContext ~mode
| None -> []
| Some innerType ->
innerType
|> completeTypedValue ~full ~prefix ~completionContext ~mode
|> completeTypedValue ~rawOpens ~full ~prefix ~completionContext ~mode
|> List.map (fun (c : Completion.t) ->
{
c with
Expand Down Expand Up @@ -1314,7 +1344,7 @@ let rec completeTypedValue ~full ~prefix ~completionContext ~mode
| None -> []
| Some innerType ->
innerType
|> completeTypedValue ~full ~prefix ~completionContext ~mode
|> completeTypedValue ~rawOpens ~full ~prefix ~completionContext ~mode
|> List.map (fun (c : Completion.t) ->
{
c with
Expand All @@ -1331,7 +1361,7 @@ let rec completeTypedValue ~full ~prefix ~completionContext ~mode
| None -> []
| Some innerType ->
innerType
|> completeTypedValue ~full ~prefix ~completionContext ~mode
|> completeTypedValue ~rawOpens ~full ~prefix ~completionContext ~mode
|> List.map (fun (c : Completion.t) ->
{
c with
Expand Down Expand Up @@ -1549,8 +1579,8 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable =
let allFiles = allFilesInPackage package in
let findTypeOfValue path =
path
|> getCompletionsForPath ~debug ~completionContext:Value ~exact:true
~package ~opens ~full ~pos ~env ~scope
|> getCompletionsForPath ~debug ~completionContext:Value ~exact:true ~opens
~full ~pos ~env ~scope
|> completionsGetTypeEnv2 ~debug ~full ~opens ~rawOpens ~pos
in
match completable with
Expand Down Expand Up @@ -1781,8 +1811,8 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable =
| Some (typ, _env, completionContext) ->
let items =
typ
|> completeTypedValue ~mode:(Pattern patternMode) ~full ~prefix
~completionContext
|> completeTypedValue ~rawOpens ~mode:(Pattern patternMode) ~full
~prefix ~completionContext
in
fallbackOrEmpty ~items ())
| None -> fallbackOrEmpty ())
Expand Down Expand Up @@ -1819,7 +1849,7 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable =
in
let items =
typ
|> completeTypedValue ~mode:Expression ~full ~prefix
|> completeTypedValue ~rawOpens ~mode:Expression ~full ~prefix
~completionContext
|> List.map (fun (c : Completion.t) ->
if wrapInsertTextInBraces then
Expand Down
1 change: 1 addition & 0 deletions analysis/src/SharedTypes.ml
Original file line number Diff line number Diff line change
Expand Up @@ -331,6 +331,7 @@ and completionType =
| Tbool of QueryEnv.t
| Tarray of QueryEnv.t * innerType
| Tstring of QueryEnv.t
| TtypeT of {env: QueryEnv.t; path: Path.t}
| Tvariant of {
env: QueryEnv.t;
constructors: Constructor.t list;
Expand Down
47 changes: 47 additions & 0 deletions analysis/src/TypeUtils.ml
Original file line number Diff line number Diff line change
Expand Up @@ -149,6 +149,7 @@ let rec extractType ~env ~package (t : Types.type_expr) =
})
| Some (env, {item = {kind = Record fields}}) ->
Some (Trecord {env; fields; definition = `TypeExpr t})
| Some (env, {item = {name = "t"}}) -> Some (TtypeT {env; path})
| _ -> None)
| Ttuple expressions -> Some (Tuple (env, expressions, t))
| Tvariant {row_fields} ->
Expand Down Expand Up @@ -631,6 +632,7 @@ let rec extractedTypeToString ?(inner = false) = function
else Shared.typeToString typ
| Tbool _ -> "bool"
| Tstring _ -> "string"
| TtypeT _ -> "type t"
| Tarray (_, TypeExpr innerTyp) ->
"array<" ^ Shared.typeToString innerTyp ^ ">"
| Tarray (_, ExtractedType innerTyp) ->
Expand Down Expand Up @@ -757,3 +759,48 @@ module Codegen = struct
|> List.map (fun (pat : Parsetree.pattern) ->
Ast_helper.Exp.case pat (mkFailWithExp ())))
end

let getPathRelativeToEnv ~debug ~(env : QueryEnv.t) ~envFromItem path =
match path with
| _ :: pathRev ->
(* type path is relative to the completion environment
express it from the root of the file *)
let found, pathFromEnv =
QueryEnv.pathFromEnv envFromItem (List.rev pathRev)
in
if debug then
Printf.printf "CPPipe pathFromEnv:%s found:%b\n"
(pathFromEnv |> String.concat ".")
found;
if pathFromEnv = [] then None
else if
env.file.moduleName <> envFromItem.file.moduleName && found
(* If the module names are different, then one needs to qualify the path.
But only if the path belongs to the env from completion *)
then Some (envFromItem.file.moduleName :: pathFromEnv)
else Some pathFromEnv
| _ -> None

let removeOpensFromCompletionPath ~rawOpens ~package completionPath =
let rec removeRawOpen rawOpen modulePath =
match (rawOpen, modulePath) with
| [_], _ -> Some modulePath
| s :: inner, first :: restPath when s = first ->
removeRawOpen inner restPath
| _ -> None
in
let rec removeRawOpens rawOpens modulePath =
match rawOpens with
| rawOpen :: restOpens -> (
let newModulePath = removeRawOpens restOpens modulePath in
match removeRawOpen rawOpen newModulePath with
| None -> newModulePath
| Some mp -> mp)
| [] -> modulePath
in
let completionPathMinusOpens =
completionPath |> Utils.flattenAnyNamespaceInPath
|> removeRawOpens package.opens
|> removeRawOpens rawOpens
in
completionPathMinusOpens
Loading
Loading