Skip to content

Commit 4fe7ffb

Browse files
committed
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 #311
1 parent 95c3a1e commit 4fe7ffb

File tree

3 files changed

+103
-69
lines changed

3 files changed

+103
-69
lines changed

analysis/src/NewCompletions.ml

+68-69
Original file line numberDiff line numberDiff line change
@@ -731,6 +731,30 @@ let resolveRawOpens ~env ~rawOpens ~package =
731731
in
732732
opens
733733

734+
let rec extractRecordType ~env ~package (t : Types.type_expr) =
735+
match t.desc with
736+
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractRecordType ~env ~package t1
737+
| Tconstr (path, _, _) -> (
738+
match References.digConstructor ~env ~package path with
739+
| Some (env, ({item = {kind = Record fields}} as typ)) ->
740+
Some (env, fields, typ)
741+
| Some (env, {item = {decl = {type_manifest = Some t1}}}) ->
742+
extractRecordType ~env ~package t1
743+
| _ -> None)
744+
| _ -> None
745+
746+
let rec extractObjectType ~env ~package (t : Types.type_expr) =
747+
match t.desc with
748+
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) ->
749+
extractObjectType ~env ~package t1
750+
| Tobject (tObj, _) -> Some (env, tObj)
751+
| Tconstr (path, _, _) -> (
752+
match References.digConstructor ~env ~package path with
753+
| Some (env, {item = {decl = {type_manifest = Some t1}}}) ->
754+
extractObjectType ~env ~package t1
755+
| _ -> None)
756+
| _ -> None
757+
734758
let getItems ~full ~rawOpens ~allFiles ~pos ~parts =
735759
Log.log
736760
("Opens folkz > "
@@ -801,49 +825,36 @@ let getItems ~full ~rawOpens ~allFiles ~pos ~parts =
801825
| None -> []
802826
| Some declared -> (
803827
Log.log ("Found it! " ^ declared.name.txt);
804-
match declared.item |> Shared.digConstructor with
828+
match declared.item |> extractRecordType ~env ~package with
805829
| None -> []
806-
| Some path -> (
807-
match References.digConstructor ~env ~package path with
808-
| None -> []
809-
| Some (env, typ) -> (
810-
match
811-
rest
812-
|> List.fold_left
813-
(fun current name ->
814-
match current with
830+
| Some (env, fields, typ) -> (
831+
match
832+
rest
833+
|> List.fold_left
834+
(fun current name ->
835+
match current with
836+
| None -> None
837+
| Some (env, fields, _) -> (
838+
match
839+
fields |> List.find_opt (fun f -> f.fname.txt = name)
840+
with
815841
| None -> None
816-
| Some (env, typ) -> (
817-
match typ.item.SharedTypes.Type.kind with
818-
| Record fields -> (
819-
match
820-
fields
821-
|> List.find_opt (fun f -> f.fname.txt = name)
822-
with
823-
| None -> None
824-
| Some attr -> (
825-
Log.log ("Found attr " ^ name);
826-
match attr.typ |> Shared.digConstructor with
827-
| None -> None
828-
| Some path ->
829-
References.digConstructor ~env ~package path))
830-
| _ -> None))
831-
(Some (env, typ))
832-
with
833-
| None -> []
834-
| Some (_env, typ) -> (
835-
match typ.item.kind with
836-
| Record fields ->
837-
fields
838-
|> Utils.filterMap (fun f ->
839-
if Utils.startsWith f.fname.txt suffix then
840-
Some
841-
{
842-
(emptyDeclared f.fname.txt) with
843-
item = Field (f, typ);
844-
}
845-
else None)
846-
| _ -> []))))))
842+
| Some attr ->
843+
Log.log ("Found attr " ^ name);
844+
attr.typ |> extractRecordType ~env ~package))
845+
(Some (env, fields, typ))
846+
with
847+
| None -> []
848+
| Some (_env, fields, typ) ->
849+
fields
850+
|> Utils.filterMap (fun f ->
851+
if Utils.startsWith f.fname.txt suffix then
852+
Some
853+
{
854+
(emptyDeclared f.fname.txt) with
855+
item = Field (f, typ);
856+
}
857+
else None)))))
847858
| `AbsAttribute path -> (
848859
match getEnvWithOpens ~pos ~env ~package ~opens path with
849860
| None -> []
@@ -993,22 +1004,15 @@ let processCompletable ~findItems ~full ~package ~rawOpens
9931004
Some (modulePath, partialName)
9941005
in
9951006
let getField ~env ~typ fieldName =
996-
match getConstr typ with
997-
| Some path -> (
998-
match References.digConstructor ~env ~package path with
1007+
match extractRecordType typ ~env ~package with
1008+
| Some (env1, fields, _) -> (
1009+
match
1010+
fields
1011+
|> List.find_opt (fun field ->
1012+
field.SharedTypes.fname.txt = fieldName)
1013+
with
9991014
| None -> None
1000-
| Some (env1, declared) -> (
1001-
let t = declared.item in
1002-
match t.kind with
1003-
| Record fields -> (
1004-
match
1005-
fields
1006-
|> List.find_opt (fun field ->
1007-
field.SharedTypes.fname.txt = fieldName)
1008-
with
1009-
| None -> None
1010-
| Some field -> Some (field.typ, env1))
1011-
| _ -> None))
1015+
| Some field -> Some (field.typ, env1))
10121016
| None -> None
10131017
in
10141018
let rec getFields ~env ~typ = function
@@ -1161,29 +1165,24 @@ let processCompletable ~findItems ~full ~package ~rawOpens
11611165
| _ -> []
11621166
in
11631167
let envRef = ref (QueryEnv.fromFile full.file) in
1164-
let rec getObj (t : Types.type_expr) =
1165-
match t.desc with
1166-
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> getObj t1
1167-
| Tobject (tObj, _) -> getFields tObj
1168-
| Tconstr (path, _, _) -> (
1169-
match References.digConstructor ~env:envRef.contents ~package path with
1170-
| Some (env, {item = {decl = {type_manifest = Some tt}}}) ->
1171-
envRef := env;
1172-
getObj tt
1173-
| _ -> [])
1174-
| _ -> []
1168+
let getObjectFields (t : Types.type_expr) =
1169+
match t |> extractObjectType ~env:envRef.contents ~package with
1170+
| Some (env, tObj) ->
1171+
envRef := env;
1172+
getFields tObj
1173+
| None -> []
11751174
in
11761175
let fields =
11771176
match [lhs] |> findItems ~exact:true with
1178-
| {SharedTypes.item = Value typ} :: _ -> getObj typ
1177+
| {SharedTypes.item = Value typ} :: _ -> getObjectFields typ
11791178
| _ -> []
11801179
in
11811180
let rec resolvePath fields path =
11821181
match path with
11831182
| name :: restPath -> (
11841183
match fields |> List.find_opt (fun (n, _) -> n = name) with
11851184
| Some (_, fieldType) ->
1186-
let innerFields = getObj fieldType in
1185+
let innerFields = getObjectFields fieldType in
11871186
resolvePath innerFields restPath
11881187
| None -> [])
11891188
| [] -> fields

analysis/tests/src/Completion.res

+5
Original file line numberDiff line numberDiff line change
@@ -83,3 +83,8 @@ let o : Obj.objT = assert false
8383
type nestedObjT = {"x": Obj.nestedObjT}
8484
let no : nestedObjT = assert false
8585
//^com no["x"]["y"]["
86+
87+
type r = {x:int, y:string}
88+
type rAlias = r
89+
let r:rAlias = assert false
90+
// ^com r.

analysis/tests/src/expected/Completion.res.txt

+30
Original file line numberDiff line numberDiff line change
@@ -554,6 +554,21 @@ DocumentSymbol tests/src/Completion.res
554554
"name": "no",
555555
"kind": 13,
556556
"location": {"uri": "Completion.res", "range": {"start": {"line": 83, "character": 4}, "end": {"line": 83, "character": 6}}}
557+
},
558+
{
559+
"name": "r",
560+
"kind": 11,
561+
"location": {"uri": "Completion.res", "range": {"start": {"line": 86, "character": 0}, "end": {"line": 86, "character": 26}}}
562+
},
563+
{
564+
"name": "rAlias",
565+
"kind": 26,
566+
"location": {"uri": "Completion.res", "range": {"start": {"line": 87, "character": 0}, "end": {"line": 87, "character": 15}}}
567+
},
568+
{
569+
"name": "r",
570+
"kind": 13,
571+
"location": {"uri": "Completion.res", "range": {"start": {"line": 88, "character": 4}, "end": {"line": 88, "character": 5}}}
557572
}
558573
]
559574

@@ -665,3 +680,18 @@ Complete tests/src/Completion.res 83:2
665680
"documentation": null
666681
}]
667682

683+
Complete tests/src/Completion.res 88:3
684+
[{
685+
"label": "x",
686+
"kind": 5,
687+
"tags": [],
688+
"detail": "x: int\n\ntype r = {x: int, y: string}",
689+
"documentation": null
690+
}, {
691+
"label": "y",
692+
"kind": 5,
693+
"tags": [],
694+
"detail": "y: string\n\ntype r = {x: int, y: string}",
695+
"documentation": null
696+
}]
697+

0 commit comments

Comments
 (0)