From c7fb72177af5c6f55cc83b0b22e53d204d16bd55 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 25 Nov 2021 11:35:23 +0100 Subject: [PATCH 1/3] New function to extract record type. The current function to extract record types looks for a type definition, and expect it to be a record. The new one keeps on expanding type definitions until it finds a record. In this way, it handles type aliases. Fixes https://github.com/rescript-lang/rescript-vscode/issues/311 --- analysis/src/NewCompletions.ml | 137 +++++++++--------- analysis/tests/src/Completion.res | 5 + .../tests/src/expected/Completion.res.txt | 30 ++++ 3 files changed, 103 insertions(+), 69 deletions(-) diff --git a/analysis/src/NewCompletions.ml b/analysis/src/NewCompletions.ml index dc5eede44..98d20f0a5 100644 --- a/analysis/src/NewCompletions.ml +++ b/analysis/src/NewCompletions.ml @@ -731,6 +731,30 @@ let resolveRawOpens ~env ~rawOpens ~package = in opens +let rec extractRecordType ~env ~package (t : Types.type_expr) = + match t.desc with + | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractRecordType ~env ~package t1 + | Tconstr (path, _, _) -> ( + match References.digConstructor ~env ~package path with + | Some (env, ({item = {kind = Record fields}} as typ)) -> + Some (env, fields, typ) + | Some (env, {item = {decl = {type_manifest = Some t1}}}) -> + extractRecordType ~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 + | Tobject (tObj, _) -> Some (env, tObj) + | Tconstr (path, _, _) -> ( + match References.digConstructor ~env ~package path with + | Some (env, {item = {decl = {type_manifest = Some t1}}}) -> + extractObjectType ~env ~package t1 + | _ -> None) + | _ -> None + let getItems ~full ~rawOpens ~allFiles ~pos ~parts = Log.log ("Opens folkz > " @@ -801,49 +825,36 @@ let getItems ~full ~rawOpens ~allFiles ~pos ~parts = | None -> [] | Some declared -> ( Log.log ("Found it! " ^ declared.name.txt); - match declared.item |> Shared.digConstructor with + match declared.item |> extractRecordType ~env ~package with | None -> [] - | Some path -> ( - match References.digConstructor ~env ~package path with - | None -> [] - | Some (env, typ) -> ( - match - rest - |> List.fold_left - (fun current name -> - match current with + | Some (env, fields, typ) -> ( + match + rest + |> List.fold_left + (fun current name -> + match current with + | None -> None + | Some (env, fields, _) -> ( + match + fields |> List.find_opt (fun f -> f.fname.txt = name) + with | None -> None - | Some (env, typ) -> ( - match typ.item.SharedTypes.Type.kind with - | Record fields -> ( - match - fields - |> List.find_opt (fun f -> f.fname.txt = name) - with - | None -> None - | Some attr -> ( - Log.log ("Found attr " ^ name); - match attr.typ |> Shared.digConstructor with - | None -> None - | Some path -> - References.digConstructor ~env ~package path)) - | _ -> None)) - (Some (env, typ)) - with - | None -> [] - | Some (_env, typ) -> ( - match typ.item.kind with - | Record fields -> - fields - |> Utils.filterMap (fun f -> - if Utils.startsWith f.fname.txt suffix then - Some - { - (emptyDeclared f.fname.txt) with - item = Field (f, typ); - } - else None) - | _ -> [])))))) + | Some attr -> + Log.log ("Found attr " ^ name); + attr.typ |> extractRecordType ~env ~package)) + (Some (env, fields, typ)) + with + | None -> [] + | Some (_env, fields, typ) -> + fields + |> Utils.filterMap (fun f -> + if Utils.startsWith f.fname.txt suffix then + Some + { + (emptyDeclared f.fname.txt) with + item = Field (f, typ); + } + else None))))) | `AbsAttribute path -> ( match getEnvWithOpens ~pos ~env ~package ~opens path with | None -> [] @@ -993,22 +1004,15 @@ let processCompletable ~findItems ~full ~package ~rawOpens Some (modulePath, partialName) in let getField ~env ~typ fieldName = - match getConstr typ with - | Some path -> ( - match References.digConstructor ~env ~package path with + match extractRecordType typ ~env ~package with + | Some (env1, fields, _) -> ( + match + fields + |> List.find_opt (fun field -> + field.SharedTypes.fname.txt = fieldName) + with | None -> None - | Some (env1, declared) -> ( - let t = declared.item in - match t.kind with - | Record fields -> ( - match - fields - |> List.find_opt (fun field -> - field.SharedTypes.fname.txt = fieldName) - with - | None -> None - | Some field -> Some (field.typ, env1)) - | _ -> None)) + | Some field -> Some (field.typ, env1)) | None -> None in let rec getFields ~env ~typ = function @@ -1161,21 +1165,16 @@ let processCompletable ~findItems ~full ~package ~rawOpens | _ -> [] in let envRef = ref (QueryEnv.fromFile full.file) in - let rec getObj (t : Types.type_expr) = - match t.desc with - | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> getObj t1 - | Tobject (tObj, _) -> getFields tObj - | Tconstr (path, _, _) -> ( - match References.digConstructor ~env:envRef.contents ~package path with - | Some (env, {item = {decl = {type_manifest = Some tt}}}) -> - envRef := env; - getObj tt - | _ -> []) - | _ -> [] + let getObjectFields (t : Types.type_expr) = + match t |> extractObjectType ~env:envRef.contents ~package with + | Some (env, tObj) -> + envRef := env; + getFields tObj + | None -> [] in let fields = match [lhs] |> findItems ~exact:true with - | {SharedTypes.item = Value typ} :: _ -> getObj typ + | {SharedTypes.item = Value typ} :: _ -> getObjectFields typ | _ -> [] in let rec resolvePath fields path = @@ -1183,7 +1182,7 @@ let processCompletable ~findItems ~full ~package ~rawOpens | name :: restPath -> ( match fields |> List.find_opt (fun (n, _) -> n = name) with | Some (_, fieldType) -> - let innerFields = getObj fieldType in + let innerFields = getObjectFields fieldType in resolvePath innerFields restPath | None -> []) | [] -> fields diff --git a/analysis/tests/src/Completion.res b/analysis/tests/src/Completion.res index a45f5bbfd..4c30ec4e0 100644 --- a/analysis/tests/src/Completion.res +++ b/analysis/tests/src/Completion.res @@ -83,3 +83,8 @@ let o : Obj.objT = assert false type nestedObjT = {"x": Obj.nestedObjT} let no : nestedObjT = assert false //^com no["x"]["y"][" + +type r = {x:int, y:string} +type rAlias = r +let r:rAlias = assert false +// ^com r. diff --git a/analysis/tests/src/expected/Completion.res.txt b/analysis/tests/src/expected/Completion.res.txt index c489e286b..2c15ce65e 100644 --- a/analysis/tests/src/expected/Completion.res.txt +++ b/analysis/tests/src/expected/Completion.res.txt @@ -554,6 +554,21 @@ DocumentSymbol tests/src/Completion.res "name": "no", "kind": 13, "location": {"uri": "Completion.res", "range": {"start": {"line": 83, "character": 4}, "end": {"line": 83, "character": 6}}} +}, +{ + "name": "r", + "kind": 11, + "location": {"uri": "Completion.res", "range": {"start": {"line": 86, "character": 0}, "end": {"line": 86, "character": 26}}} +}, +{ + "name": "rAlias", + "kind": 26, + "location": {"uri": "Completion.res", "range": {"start": {"line": 87, "character": 0}, "end": {"line": 87, "character": 15}}} +}, +{ + "name": "r", + "kind": 13, + "location": {"uri": "Completion.res", "range": {"start": {"line": 88, "character": 4}, "end": {"line": 88, "character": 5}}} } ] @@ -665,3 +680,18 @@ Complete tests/src/Completion.res 83:2 "documentation": null }] +Complete tests/src/Completion.res 88:3 +[{ + "label": "x", + "kind": 5, + "tags": [], + "detail": "x: int\n\ntype r = {x: int, y: string}", + "documentation": null + }, { + "label": "y", + "kind": 5, + "tags": [], + "detail": "y: string\n\ntype r = {x: int, y: string}", + "documentation": null + }] + From cbfe468619383acd6d28bc09623862fca7b2f8bc Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 25 Nov 2021 11:36:34 +0100 Subject: [PATCH 2/3] Update CHANGELOG.md --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 3f5d548b8..2c967afd9 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,7 @@ - Fix issue with autocomplete then punned props are used in JSX. E.g. ``. - Fix issue with JSX autocompletion not working after `foo=#variant`. - Fix issue in JSX autocompletion where the `key` label would always appear. +- Fix issue in record field autocomplete not working with type aliases. ## 1.1.3 From 5ae5cc181d34d4f6833c7560cfd2e8a8fe850b4c Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 25 Nov 2021 13:15:42 +0100 Subject: [PATCH 3/3] refactor: remove reference --- analysis/src/NewCompletions.ml | 33 +++++++++++++++------------------ 1 file changed, 15 insertions(+), 18 deletions(-) diff --git a/analysis/src/NewCompletions.ml b/analysis/src/NewCompletions.ml index 98d20f0a5..7b139f736 100644 --- a/analysis/src/NewCompletions.ml +++ b/analysis/src/NewCompletions.ml @@ -745,8 +745,7 @@ let rec extractRecordType ~env ~package (t : Types.type_expr) = let rec extractObjectType ~env ~package (t : Types.type_expr) = match t.desc with - | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> - extractObjectType ~env ~package t1 + | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractObjectType ~env ~package t1 | Tobject (tObj, _) -> Some (env, tObj) | Tconstr (path, _, _) -> ( match References.digConstructor ~env ~package path with @@ -1164,30 +1163,28 @@ let processCompletable ~findItems ~full ~package ~rawOpens | Tvar None -> [] | _ -> [] in - let envRef = ref (QueryEnv.fromFile full.file) in - let getObjectFields (t : Types.type_expr) = - match t |> extractObjectType ~env:envRef.contents ~package with - | Some (env, tObj) -> - envRef := env; - getFields tObj - | None -> [] - in - let fields = - match [lhs] |> findItems ~exact:true with - | {SharedTypes.item = Value typ} :: _ -> getObjectFields typ - | _ -> [] + let getObjectFields ~env (t : Types.type_expr) = + match t |> extractObjectType ~env ~package with + | Some (env, tObj) -> (env, getFields tObj) + | None -> (env, []) in - let rec resolvePath fields path = + let rec resolvePath ~env fields path = match path with | name :: restPath -> ( match fields |> List.find_opt (fun (n, _) -> n = name) with | Some (_, fieldType) -> - let innerFields = getObjectFields fieldType in - resolvePath innerFields restPath + let env, innerFields = getObjectFields ~env fieldType in + resolvePath ~env innerFields restPath | None -> []) | [] -> fields in - let labels = resolvePath fields path in + let env0 = QueryEnv.fromFile full.file in + let env, fields = + match [lhs] |> findItems ~exact:true with + | {SharedTypes.item = Value typ} :: _ -> getObjectFields ~env:env0 typ + | _ -> (env0, []) + in + let labels = resolvePath ~env fields path in let mkLabel_ name typString = mkItem ~name ~kind:4 ~deprecated:None ~detail:typString ~docstring:[] in