fix signature of @jsx.component

Author: tsnobip

compiler/syntax/src/jsx_common.ml

@@ -7,14 +7,15 @@ type jsx_config = {
   mutable nested_modules: string list;
   mutable has_component: bool;
   mutable hoisted_structure_items: structure_item list;
-  (* Nesting depth of [structure] calls while rewriting one implementation.
+  mutable hoisted_signature_items: signature_item list;
+  (* Nesting depth of [structure] / [signature] while rewriting one file.
      Used so we only clear/append hoisted items at the true file root — not for
-     nested [Pmod_structure] reached from expression traversal (e.g. via
-     [module_expr]), which would otherwise see [nested_modules = []] and wipe
-     hoisted bindings added for earlier structure items. *)
+     nested [Pmod_structure] / [Pmty_signature] reached from inner traversal,
+     which would otherwise wipe hoists from earlier items. *)
   mutable structure_depth: int;
-  (* Inside [Pmod_functor] bodies, hoisting [File$M = M.make] at the file top
-     would reference [M] as a functor (illegal). Skip hoists when > 0. *)
+  (* Inside [Pmod_functor] / [Pmty_functor] bodies, hoisting [File$M = M.make]
+     at the file top would reference [M] as a functor (illegal). Skip hoists
+     when > 0. *)
   mutable functor_depth: int;
 }
 

compiler/syntax/src/jsx_ppx.ml

@@ -98,6 +98,37 @@ let get_mapper ~config =
         raise e)
     | _ -> default_mapper.module_expr mapper me
   in
+  let module_type mapper mt =
+    match (config.version, mt.pmty_desc) with
+    | 4, Pmty_functor _ -> (
+      config.functor_depth <- config.functor_depth + 1;
+      try
+        let m = default_mapper.module_type mapper mt in
+        config.functor_depth <- config.functor_depth - 1;
+        m
+      with e ->
+        config.functor_depth <- config.functor_depth - 1;
+        raise e)
+    | _ -> default_mapper.module_type mapper mt
+  in
+  let module_declaration mapper md =
+    match config.version with
+    | 4 ->
+      config.nested_modules <- md.pmd_name.txt :: config.nested_modules;
+      let mapped =
+        try default_mapper.module_declaration mapper md
+        with e ->
+          (match config.nested_modules with
+          | _ :: rest -> config.nested_modules <- rest
+          | [] -> ());
+          raise e
+      in
+      (match config.nested_modules with
+      | _ :: rest -> config.nested_modules <- rest
+      | [] -> ());
+      mapped
+    | _ -> default_mapper.module_declaration mapper md
+  in
   let save_config () =
     {
       config with
@@ -113,7 +144,10 @@ let get_mapper ~config =
   in
   let signature mapper items =
     let old_config = save_config () in
+    let is_top_level = config.structure_depth = 0 in
+    config.structure_depth <- config.structure_depth + 1;
     config.has_component <- false;
+    if is_top_level then config.hoisted_signature_items <- [];
     let result =
       List.map
         (fun item ->
@@ -125,6 +159,12 @@ let get_mapper ~config =
         items
       |> List.flatten
     in
+    let result =
+      if config.version = 4 && is_top_level then
+        result @ List.rev config.hoisted_signature_items
+      else result
+    in
+    config.structure_depth <- config.structure_depth - 1;
     restore_config old_config;
     result
   in
@@ -155,7 +195,16 @@ let get_mapper ~config =
     result
   in
 
-  {default_mapper with expr; module_binding; module_expr; signature; structure}
+  {
+    default_mapper with
+    expr;
+    module_binding;
+    module_expr;
+    module_type;
+    module_declaration;
+    signature;
+    structure;
+  }
 
 let rewrite_implementation ~jsx_version ~jsx_module (code : Parsetree.structure)
     : Parsetree.structure =
@@ -166,6 +215,7 @@ let rewrite_implementation ~jsx_version ~jsx_module (code : Parsetree.structure)
       nested_modules = [];
       has_component = false;
       hoisted_structure_items = [];
+      hoisted_signature_items = [];
       structure_depth = 0;
       functor_depth = 0;
     }
@@ -182,6 +232,7 @@ let rewrite_signature ~jsx_version ~jsx_module (code : Parsetree.signature) :
       nested_modules = [];
       has_component = false;
       hoisted_structure_items = [];
+      hoisted_signature_items = [];
       structure_depth = 0;
       functor_depth = 0;
     }

compiler/syntax/src/jsx_v4.ml

@@ -85,6 +85,17 @@ let longident_of_segments = function
   | head :: rest ->
     List.fold_left (fun acc name -> Ldot (acc, name)) (Lident head) rest
 
+(* [nested_modules] is the same stack as [config.nested_modules] while inside a
+   nested [module M: { ... }]: outermost submodule name is at the tail. *)
+let props_longident_for_nested_module nested_modules =
+  match List.rev nested_modules with
+  | [] -> Lident "props"
+  | m :: rest ->
+    let mod_path =
+      List.fold_left (fun acc name -> Ldot (acc, name)) (Lident m) rest
+    in
+    Ldot (mod_path, "props")
+
 let make_hoisted_component_binding ~empty_loc ~full_module_name nested_modules =
   let path =
     nested_modules |> List.rev |> longident_of_segments |> fun txt ->
@@ -140,6 +151,44 @@ let maybe_hoist_nested_make_component ~(config : Jsx_common.jsx_config)
       :: config.hoisted_structure_items
   | _ -> ()
 
+let make_hoisted_component_signature ~empty_loc ~full_module_name
+    (component_type : Parsetree.core_type) =
+  let marker_name = full_module_name ^ "$jsx" in
+  let bool_ty =
+    Typ.constr ~loc:empty_loc {loc = empty_loc; txt = Lident "bool"} []
+  in
+  let full_sig =
+    {
+      psig_loc = empty_loc;
+      psig_desc =
+        Psig_value
+          (Val.mk ~loc:empty_loc
+             {loc = empty_loc; txt = full_module_name}
+             component_type);
+    }
+  in
+  let jsx_sig =
+    {
+      psig_loc = empty_loc;
+      psig_desc =
+        Psig_value
+          (Val.mk ~loc:empty_loc {loc = empty_loc; txt = marker_name} bool_ty);
+    }
+  in
+  (full_sig, jsx_sig)
+
+let maybe_hoist_nested_make_signature ~(config : Jsx_common.jsx_config)
+    ~empty_loc ~full_module_name ~component_type fn_name =
+  match (fn_name, config.nested_modules, config.functor_depth) with
+  | "make", _ :: _, 0 ->
+    let full_sig, jsx_sig =
+      make_hoisted_component_signature ~empty_loc ~full_module_name
+        component_type
+    in
+    config.hoisted_signature_items <-
+      jsx_sig :: full_sig :: config.hoisted_signature_items
+  | _ -> ()
+
 (* Build a string representation of a module name with segments separated by $ *)
 let make_module_name file_name nested_modules fn_name =
   let file_name = unnamespace_module_name file_name in
@@ -1101,7 +1150,8 @@ let transform_signature_item ~config item =
   match item with
   | {
       psig_loc;
-      psig_desc = Psig_value ({pval_attributes; pval_type} as psig_desc);
+      psig_desc =
+        Psig_value ({pval_attributes; pval_type; pval_name} as psig_desc);
     } as psig -> (
     match List.filter Jsx_common.has_attr pval_attributes with
     | [] -> [item]
@@ -1117,15 +1167,25 @@ let transform_signature_item ~config item =
       in
       let prop_types = collect_prop_types [] pval_type in
       let named_type_list = List.fold_left arg_to_concrete_type [] prop_types in
+      let props_type_args =
+        match core_type_of_attr with
+        | None -> make_props_type_params named_type_list
+        | Some _ -> (
+          match typ_vars_of_core_type with
+          | [] -> []
+          | _ -> [Typ.any ()])
+      in
       let ret_props_type =
         Typ.constr
           (Location.mkloc (Lident "props") psig_loc)
-          (match core_type_of_attr with
-          | None -> make_props_type_params named_type_list
-          | Some _ -> (
-            match typ_vars_of_core_type with
-            | [] -> []
-            | _ -> [Typ.any ()]))
+          props_type_args
+      in
+      let ret_props_type_for_hoist =
+        Typ.constr
+          (Location.mkloc
+             (props_longident_for_nested_module config.nested_modules)
+             psig_loc)
+          props_type_args
       in
       let external_ = psig_desc.pval_prim <> [] in
       let props_record_type =
@@ -1138,6 +1198,11 @@ let transform_signature_item ~config item =
           ( {loc = psig_loc; txt = module_access_name config "component"},
             [ret_props_type] )
       in
+      let new_external_type_for_hoist =
+        Ptyp_constr
+          ( {loc = psig_loc; txt = module_access_name config "component"},
+            [ret_props_type_for_hoist] )
+      in
       let new_structure =
         {
           psig with
@@ -1150,6 +1215,16 @@ let transform_signature_item ~config item =
               };
         }
       in
+      let file_name = filename_from_loc psig_loc in
+      let empty_loc = Location.in_file file_name in
+      let full_module_name =
+        make_module_name file_name config.nested_modules pval_name.txt
+      in
+      let component_type =
+        {pval_type with ptyp_desc = new_external_type_for_hoist}
+      in
+      maybe_hoist_nested_make_signature ~config ~empty_loc ~full_module_name
+        ~component_type pval_name.txt;
       [props_record_type; new_structure]
     | _ ->
       Jsx_common.raise_error ~loc:psig_loc

tests/syntax_tests/data/ppx/react/expected/firstClassModules.resi.txt

@@ -22,3 +22,12 @@ module Select: {
     >,
   >
 }
+let \"FirstClassModules$Select": React.component<
+  Select.props<
+    module(T with type t = 'a and type key = 'key),
+    option<'key>,
+    option<'key> => unit,
+    array<'a>,
+  >,
+>
+let \"FirstClassModules$Select$jsx": bool

tests/syntax_tests/data/ppx/react/expected/forwardRef.resi.txt

@@ -89,3 +89,35 @@ module V4AUncurried: {
     let make: React.component<props<React.ref<Js.Nullable.t<inputRef>>>>
   }
 }
+let \"ForwardRef$V4C$FancyInput": React.component<
+  V4C.FancyInput.props<string, React.element, ReactDOM.Ref.currentDomRef>,
+>
+let \"ForwardRef$V4C$FancyInput$jsx": bool
+let \"ForwardRef$V4C$ForwardRef": React.component<
+  V4C.ForwardRef.props<React.ref<Js.Nullable.t<inputRef>>>,
+>
+let \"ForwardRef$V4C$ForwardRef$jsx": bool
+let \"ForwardRef$V4CUncurried$FancyInput": React.component<
+  V4CUncurried.FancyInput.props<string, React.element, ReactDOM.Ref.currentDomRef>,
+>
+let \"ForwardRef$V4CUncurried$FancyInput$jsx": bool
+let \"ForwardRef$V4CUncurried$ForwardRef": React.component<
+  V4CUncurried.ForwardRef.props<React.ref<Js.Nullable.t<inputRef>>>,
+>
+let \"ForwardRef$V4CUncurried$ForwardRef$jsx": bool
+let \"ForwardRef$V4A$FancyInput": React.component<
+  V4A.FancyInput.props<string, React.element, ReactDOM.Ref.currentDomRef>,
+>
+let \"ForwardRef$V4A$FancyInput$jsx": bool
+let \"ForwardRef$V4A$ForwardRef": React.component<
+  V4A.ForwardRef.props<React.ref<Js.Nullable.t<inputRef>>>,
+>
+let \"ForwardRef$V4A$ForwardRef$jsx": bool
+let \"ForwardRef$V4AUncurried$FancyInput": React.component<
+  V4AUncurried.FancyInput.props<string, React.element, ReactDOM.Ref.currentDomRef>,
+>
+let \"ForwardRef$V4AUncurried$FancyInput$jsx": bool
+let \"ForwardRef$V4AUncurried$ForwardRef": React.component<
+  V4AUncurried.ForwardRef.props<React.ref<Js.Nullable.t<inputRef>>>,
+>
+let \"ForwardRef$V4AUncurried$ForwardRef$jsx": bool

tests/syntax_tests/data/ppx/react/expected/interface.resi.txt

@@ -12,3 +12,7 @@ module NoProps: {
 
   let make: React.component<props>
 }
+let \"Interface$A": React.component<A.props<string>>
+let \"Interface$A$jsx": bool
+let \"Interface$NoProps": React.component<NoProps.props>
+let \"Interface$NoProps$jsx": bool

tests/syntax_tests/data/ppx/react/expected/sharedProps.resi.txt

@@ -49,3 +49,19 @@ module V4A4: {
 
   let make: React.component<props>
 }
+let \"SharedProps$V4C1": React.component<V4C1.props>
+let \"SharedProps$V4C1$jsx": bool
+let \"SharedProps$V4C2": React.component<V4C2.props<_>>
+let \"SharedProps$V4C2$jsx": bool
+let \"SharedProps$V4C3": React.component<V4C3.props<_>>
+let \"SharedProps$V4C3$jsx": bool
+let \"SharedProps$V4C4": React.component<V4C4.props>
+let \"SharedProps$V4C4$jsx": bool
+let \"SharedProps$V4A1": React.component<V4A1.props>
+let \"SharedProps$V4A1$jsx": bool
+let \"SharedProps$V4A2": React.component<V4A2.props<_>>
+let \"SharedProps$V4A2$jsx": bool
+let \"SharedProps$V4A3": React.component<V4A3.props<_>>
+let \"SharedProps$V4A3$jsx": bool
+let \"SharedProps$V4A4": React.component<V4A4.props>
+let \"SharedProps$V4A4$jsx": bool