diff --git a/CHANGELOG.md b/CHANGELOG.md index d050fedec..d762ee136 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,6 +15,7 @@ #### :rocket: New Feature - Add support for prop completion for JSX V4 https://github.com/rescript-lang/rescript-vscode/pull/579 +- Add support for create interface file for JSX V4 https://github.com/rescript-lang/rescript-vscode/pull/580 ## v1.6.0 diff --git a/analysis/src/CreateInterface.ml b/analysis/src/CreateInterface.ml index 866dfe247..07b96d153 100644 --- a/analysis/src/CreateInterface.ml +++ b/analysis/src/CreateInterface.ml @@ -164,7 +164,7 @@ let printSignature ~extractor ~signature = let buf = Buffer.create 10 in - let getComponentType (typ : Types.type_expr) = + let getComponentTypeV3 (typ : Types.type_expr) = let reactElement = Ctype.newconstr (Pdot (Pident (Ident.create "React"), "element", 0)) [] in @@ -183,6 +183,29 @@ let printSignature ~extractor ~signature = | _ -> None in + let getComponentTypeV4 (typ : Types.type_expr) = + let reactElement = + Ctype.newconstr (Pdot (Pident (Ident.create "React"), "element", 0)) [] + in + match typ.desc with + | Tarrow (_, {desc = Tconstr (Path.Pident propsId, typeArgs, _)}, retType, _) + when Ident.name propsId = "props" -> + Some (typeArgs, retType) + | Tconstr + ( Pdot (Pident {name = "React"}, "component", _), + [{desc = Tconstr (Path.Pident propsId, typeArgs, _)}], + _ ) + when Ident.name propsId = "props" -> + Some (typeArgs, reactElement) + | Tconstr + ( Pdot (Pident {name = "React"}, "componentLike", _), + [{desc = Tconstr (Path.Pident propsId, typeArgs, _)}; retType], + _ ) + when Ident.name propsId = "props" -> + Some (typeArgs, retType) + | _ -> None + in + let rec processSignature ~indent (signature : Types.signature) : unit = match signature with | Sig_value @@ -193,14 +216,14 @@ let printSignature ~extractor ~signature = when Ident.name makePropsId = Ident.name makeId ^ "Props" && ((* from implementation *) makePropsLoc.loc_ghost || (* from interface *) makePropsLoc = makeValueDesc.val_loc) - && getComponentType makeValueDesc.val_type <> None -> + && getComponentTypeV3 makeValueDesc.val_type <> None -> (* {"name": string} => retType ~~> (~name:string) => retType React.component<{"name": string}> ~~> (~name:string) => React.element React.componentLike<{"name": string}, retType> ~~> (~name:string) => retType *) let tObj, retType = - match getComponentType makeValueDesc.val_type with + match getComponentTypeV3 makeValueDesc.val_type with | None -> assert false | Some (tObj, retType) -> (tObj, retType) in @@ -213,6 +236,60 @@ let printSignature ~extractor ~signature = Buffer.add_string buf (indent ^ "@react.component\n"); Buffer.add_string buf (indent ^ newItemStr ^ "\n"); processSignature ~indent rest + | Sig_type + ( propsId, + { + type_params; + type_kind = Type_record (labelDecls, Record_optional_labels optLbls); + }, + _ ) + :: Sig_value (makeId (* make *), makeValueDesc) + :: rest + when Ident.name propsId = "props" + && getComponentTypeV4 makeValueDesc.val_type <> None + && optLbls |> List.mem "key" -> + (* PPX V4 component declaration: + type props = {..., key?: _} + let v = ... + *) + let newItemStr = + let typeArgs, retType = + match getComponentTypeV4 makeValueDesc.val_type with + | Some x -> x + | None -> assert false + in + let rec mkFunType (labelDecls : Types.label_declaration list) = + match labelDecls with + | [] -> retType + | labelDecl :: rest -> + let propType = + CompletionBackEnd.instantiateType ~typeParams:type_params + ~typeArgs labelDecl.ld_type + in + let lblName = labelDecl.ld_id |> Ident.name in + let lbl = + if List.mem lblName optLbls then Asttypes.Optional lblName + else Labelled lblName + in + if lblName = "key" then mkFunType rest + else + {retType with desc = Tarrow (lbl, propType, mkFunType rest, Cok)} + in + let funType = + if List.length labelDecls = 1 (* No props: only "key "*) then + let tUnit = + Ctype.newconstr (Path.Pident (Ident.create "unit")) [] + in + {retType with desc = Tarrow (Nolabel, tUnit, retType, Cok)} + else mkFunType labelDecls + in + sigItemToString + (Printtyp.tree_of_value_description makeId + {makeValueDesc with val_type = funType}) + in + Buffer.add_string buf (indent ^ "@react.component\n"); + Buffer.add_string buf (indent ^ newItemStr ^ "\n"); + processSignature ~indent rest | Sig_module (id, modDecl, recStatus) :: rest -> let colonOrEquals = match modDecl.md_type with diff --git a/analysis/vendor/compiler-libs-406/includecore.ml b/analysis/vendor/compiler-libs-406/includecore.ml index 4982a8a5c..8569eddaa 100644 --- a/analysis/vendor/compiler-libs-406/includecore.ml +++ b/analysis/vendor/compiler-libs-406/includecore.ml @@ -306,7 +306,7 @@ let type_declarations ?(equality = false) ~loc env name decl1 id decl2 = let err = compare_records ~loc env decl1.type_params decl2.type_params 1 labels1 labels2 in if err <> [] || rep1 = rep2 then err else - [Record_representation (rep2 = Record_float)] + [Record_representation (rep2 = Record_float_unused)] | (Type_open, Type_open) -> [] | (_, _) -> [Kind] in diff --git a/analysis/vendor/compiler-libs-406/typecore.ml b/analysis/vendor/compiler-libs-406/typecore.ml index d71f52401..9802f3242 100644 --- a/analysis/vendor/compiler-libs-406/typecore.ml +++ b/analysis/vendor/compiler-libs-406/typecore.ml @@ -780,7 +780,7 @@ module Label = NameChoice (struct let unbound_name_error = Typetexp.unbound_label_error let in_env lbl = match lbl.lbl_repres with - | Record_regular | Record_float | Record_unboxed false -> true + | Record_regular | Record_optional_labels _ | Record_float_unused | Record_unboxed false -> true | Record_unboxed true | Record_inlined _ | Record_extension -> false end) @@ -2015,9 +2015,9 @@ struct | Texp_record { fields = es; extended_expression = eo; representation = rep } -> let use = match rep with - | Record_float -> Use.inspect + | Record_float_unused -> Use.inspect | Record_unboxed _ -> (fun x -> x) - | Record_regular | Record_inlined _ + | Record_regular | Record_optional_labels _ | Record_inlined _ | Record_extension -> Use.guard in let field env = function diff --git a/analysis/vendor/compiler-libs-406/typedecl.ml b/analysis/vendor/compiler-libs-406/typedecl.ml index 2369b84c6..9d364da03 100644 --- a/analysis/vendor/compiler-libs-406/typedecl.ml +++ b/analysis/vendor/compiler-libs-406/typedecl.ml @@ -495,7 +495,7 @@ let transl_declaration env sdecl id = let rep = if unbox then Record_unboxed false else if List.for_all (fun l -> is_float env l.Types.ld_type) lbls' - then Record_float + then Record_float_unused else Record_regular in Ttype_record lbls, Type_record(lbls', rep) diff --git a/analysis/vendor/compiler-libs-406/types.ml b/analysis/vendor/compiler-libs-406/types.ml index 7ef6eaff6..fd3de4e4e 100644 --- a/analysis/vendor/compiler-libs-406/types.ml +++ b/analysis/vendor/compiler-libs-406/types.ml @@ -159,11 +159,12 @@ and type_kind = | Type_open and record_representation = - Record_regular (* All fields are boxed / tagged *) - | Record_float (* All fields are floats *) - | Record_unboxed of bool (* Unboxed single-field record, inlined or not *) - | Record_inlined of int (* Inlined record *) - | Record_extension (* Inlined record under extension *) + | Record_regular (* All fields are boxed / tagged *) + | Record_float_unused (* Was: all fields are floats. Now: unused *) + | Record_unboxed of bool (* Unboxed single-field record, inlined or not *) + | Record_inlined of int (* Inlined record *) + | Record_extension (* Inlined record under extension *) + | Record_optional_labels of string list (* List of optional labels *) and label_declaration = { @@ -346,4 +347,4 @@ type label_description = lbl_private: private_flag; (* Read-only field? *) lbl_loc: Location.t; lbl_attributes: Parsetree.attributes; - } + } \ No newline at end of file diff --git a/analysis/vendor/compiler-libs-406/types.mli b/analysis/vendor/compiler-libs-406/types.mli index 28317b523..0dc914b46 100644 --- a/analysis/vendor/compiler-libs-406/types.mli +++ b/analysis/vendor/compiler-libs-406/types.mli @@ -305,11 +305,12 @@ and type_kind = | Type_open and record_representation = - Record_regular (* All fields are boxed / tagged *) - | Record_float (* All fields are floats *) - | Record_unboxed of bool (* Unboxed single-field record, inlined or not *) - | Record_inlined of int (* Inlined record *) - | Record_extension (* Inlined record under extension *) + | Record_regular (* All fields are boxed / tagged *) + | Record_float_unused (* Was: all fields are floats. Now: unused *) + | Record_unboxed of bool (* Unboxed single-field record, inlined or not *) + | Record_inlined of int (* Inlined record *) + | Record_extension (* Inlined record under extension *) + | Record_optional_labels of string list (* List of optional labels *) and label_declaration = {