@@ -731,6 +731,30 @@ let resolveRawOpens ~env ~rawOpens ~package =
731
731
in
732
732
opens
733
733
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
+
734
758
let getItems ~full ~rawOpens ~allFiles ~pos ~parts =
735
759
Log. log
736
760
(" Opens folkz > "
@@ -801,49 +825,36 @@ let getItems ~full ~rawOpens ~allFiles ~pos ~parts =
801
825
| None -> []
802
826
| Some declared -> (
803
827
Log. log (" Found it! " ^ declared.name.txt);
804
- match declared.item |> Shared. digConstructor with
828
+ match declared.item |> extractRecordType ~env ~package with
805
829
| 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
815
841
| 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 )))))
847
858
| `AbsAttribute path -> (
848
859
match getEnvWithOpens ~pos ~env ~package ~opens path with
849
860
| None -> []
@@ -993,22 +1004,15 @@ let processCompletable ~findItems ~full ~package ~rawOpens
993
1004
Some (modulePath, partialName)
994
1005
in
995
1006
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
999
1014
| 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))
1012
1016
| None -> None
1013
1017
in
1014
1018
let rec getFields ~env ~typ = function
@@ -1161,29 +1165,24 @@ let processCompletable ~findItems ~full ~package ~rawOpens
1161
1165
| _ -> []
1162
1166
in
1163
1167
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 -> []
1175
1174
in
1176
1175
let fields =
1177
1176
match [lhs] |> findItems ~exact: true with
1178
- | {SharedTypes. item = Value typ } :: _ -> getObj typ
1177
+ | {SharedTypes. item = Value typ } :: _ -> getObjectFields typ
1179
1178
| _ -> []
1180
1179
in
1181
1180
let rec resolvePath fields path =
1182
1181
match path with
1183
1182
| name :: restPath -> (
1184
1183
match fields |> List. find_opt (fun (n , _ ) -> n = name) with
1185
1184
| Some (_ , fieldType ) ->
1186
- let innerFields = getObj fieldType in
1185
+ let innerFields = getObjectFields fieldType in
1187
1186
resolvePath innerFields restPath
1188
1187
| None -> [] )
1189
1188
| [] -> fields
0 commit comments