@@ -46,7 +46,33 @@ let ref_type loc =
4646 {loc; txt = Ldot (Ldot (Lident " Js" , " Nullable" ), " t" )}
4747 [ref_type_var loc]
4848
49- let merlin_focus = ({loc = Location. none; txt = " merlin.focus" }, PStr [] )
49+ let jsx_element_type ~loc =
50+ Typ. constr ~loc {loc; txt = Ldot (Lident " Jsx" , " element" )} []
51+
52+ let jsx_element_constraint expr =
53+ Exp. constraint_ expr (jsx_element_type ~loc: expr.pexp_loc)
54+
55+ (* Traverse the component body and force every reachable return expression to
56+ be annotated as `Jsx.element`. This walks through the wrapper constructs the
57+ PPX introduces (fun/newtype/let/sequence) so that the constraint ends up on
58+ the real return position even after we rewrite the function. *)
59+ let rec constrain_jsx_return expr =
60+ match expr.pexp_desc with
61+ | Pexp_fun ({rhs} as desc ) ->
62+ {expr with pexp_desc = Pexp_fun {desc with rhs = constrain_jsx_return rhs}}
63+ | Pexp_newtype (param , inner ) ->
64+ {expr with pexp_desc = Pexp_newtype (param, constrain_jsx_return inner)}
65+ | Pexp_constraint (inner , _ ) ->
66+ let constrained_inner = constrain_jsx_return inner in
67+ jsx_element_constraint constrained_inner
68+ | Pexp_let (rec_flag , bindings , body ) ->
69+ {
70+ expr with
71+ pexp_desc = Pexp_let (rec_flag, bindings, constrain_jsx_return body);
72+ }
73+ | Pexp_sequence (first , second ) ->
74+ {expr with pexp_desc = Pexp_sequence (first, constrain_jsx_return second)}
75+ | _ -> jsx_element_constraint expr
5076
5177(* Helper method to filter out any attribute that isn't [@react.component] *)
5278let other_attrs_pure (loc , _ ) =
@@ -73,7 +99,7 @@ let make_new_binding binding expression new_name =
7399 pvb_pat =
74100 {pvb_pat with ppat_desc = Ppat_var {ppat_var with txt = new_name}};
75101 pvb_expr = expression;
76- pvb_attributes = [merlin_focus ];
102+ pvb_attributes = [] ;
77103 }
78104 | {pvb_loc} ->
79105 Jsx_common. raise_error ~loc: pvb_loc
@@ -713,6 +739,7 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding =
713739 vb_match_expr named_arg_list expression
714740 else expression
715741 in
742+ let expression = constrain_jsx_return expression in
716743 (* (ref) => expr *)
717744 let expression =
718745 List. fold_left
@@ -839,21 +866,26 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding =
839866 | _ -> Pat. var {txt = " props" ; loc}
840867 in
841868
869+ let applied_expression =
870+ Exp. apply
871+ (Exp. ident
872+ {
873+ txt =
874+ Lident
875+ (match rec_flag with
876+ | Recursive -> internal_fn_name
877+ | Nonrecursive -> fn_name);
878+ loc;
879+ })
880+ [(Nolabel , Exp. ident {txt = Lident " props" ; loc})]
881+ in
882+ let applied_expression =
883+ Jsx_common. async_component ~async: is_async applied_expression
884+ in
885+ let applied_expression = constrain_jsx_return applied_expression in
842886 let wrapper_expr =
843887 Exp. fun_ ~arity: None Nolabel None props_pattern
844- ~attrs: binding.pvb_expr.pexp_attributes
845- (Jsx_common. async_component ~async: is_async
846- (Exp. apply
847- (Exp. ident
848- {
849- txt =
850- Lident
851- (match rec_flag with
852- | Recursive -> internal_fn_name
853- | Nonrecursive -> fn_name);
854- loc;
855- })
856- [(Nolabel , Exp. ident {txt = Lident " props" ; loc})]))
888+ ~attrs: binding.pvb_expr.pexp_attributes applied_expression
857889 in
858890
859891 let wrapper_expr = Ast_uncurried. uncurried_fun ~arity: 1 wrapper_expr in
@@ -876,20 +908,33 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding =
876908 Some
877909 (make_new_binding ~loc: empty_loc ~full_module_name modified_binding)
878910 in
911+ let binding_expr =
912+ {
913+ binding.pvb_expr with
914+ (* moved to wrapper_expr *)
915+ pexp_attributes = [] ;
916+ }
917+ in
879918 ( None ,
880919 {
881920 binding with
882921 pvb_attributes = binding.pvb_attributes |> List. filter other_attrs_pure;
883- pvb_expr =
884- {
885- binding.pvb_expr with
886- (* moved to wrapper_expr *)
887- pexp_attributes = [] ;
888- };
922+ pvb_expr = binding_expr |> constrain_jsx_return;
889923 },
890924 new_binding )
891925 else (None , binding, None )
892926
927+ let rec collect_prop_types types {ptyp_loc; ptyp_desc} =
928+ match ptyp_desc with
929+ | Ptyp_arrow {arg; ret = {ptyp_desc = Ptyp_arrow _} as rest}
930+ when is_labelled arg.lbl || is_optional arg.lbl ->
931+ collect_prop_types ((arg.lbl, arg.attrs, ptyp_loc, arg.typ) :: types) rest
932+ | Ptyp_arrow {arg = {lbl = Nolabel } ; ret} -> collect_prop_types types ret
933+ | Ptyp_arrow {arg; ret = return_value}
934+ when is_labelled arg.lbl || is_optional arg.lbl ->
935+ (arg.lbl, arg.attrs, return_value.ptyp_loc, arg.typ) :: types
936+ | _ -> types
937+
893938let transform_structure_item ~config item =
894939 match item with
895940 (* external *)
@@ -922,19 +967,7 @@ let transform_structure_item ~config item =
922967 |> Option. map Jsx_common. typ_vars_of_core_type
923968 |> Option. value ~default: []
924969 in
925- let rec get_prop_types types ({ptyp_loc; ptyp_desc} as full_type ) =
926- match ptyp_desc with
927- | Ptyp_arrow {arg; ret = {ptyp_desc = Ptyp_arrow _} as typ2}
928- when is_labelled arg.lbl || is_optional arg.lbl ->
929- get_prop_types ((arg.lbl, arg.attrs, ptyp_loc, arg.typ) :: types) typ2
930- | Ptyp_arrow {arg = {lbl = Nolabel } ; ret} -> get_prop_types types ret
931- | Ptyp_arrow {arg; ret = return_value}
932- when is_labelled arg.lbl || is_optional arg.lbl ->
933- ( return_value,
934- (arg.lbl, arg.attrs, return_value.ptyp_loc, arg.typ) :: types )
935- | _ -> (full_type, types)
936- in
937- let inner_type, prop_types = get_prop_types [] pval_type in
970+ let prop_types = collect_prop_types [] pval_type in
938971 let named_type_list = List. fold_left arg_to_concrete_type [] prop_types in
939972 let ret_props_type =
940973 Typ. constr ~loc: pstr_loc
@@ -955,7 +988,7 @@ let transform_structure_item ~config item =
955988 let new_external_type =
956989 Ptyp_constr
957990 ( {loc = pstr_loc; txt = module_access_name config " componentLike" },
958- [ret_props_type; inner_type ] )
991+ [ret_props_type; jsx_element_type ~loc: pstr_loc ] )
959992 in
960993 let new_structure =
961994 {
@@ -1023,30 +1056,7 @@ let transform_signature_item ~config item =
10231056 |> Option. map Jsx_common. typ_vars_of_core_type
10241057 |> Option. value ~default: []
10251058 in
1026- let rec get_prop_types types ({ptyp_loc; ptyp_desc} as full_type ) =
1027- match ptyp_desc with
1028- | Ptyp_arrow {arg; ret = {ptyp_desc = Ptyp_arrow _} as rest}
1029- when is_optional arg.lbl || is_labelled arg.lbl ->
1030- get_prop_types ((arg.lbl, arg.attrs, ptyp_loc, arg.typ) :: types) rest
1031- | Ptyp_arrow
1032- {
1033- arg =
1034- {
1035- lbl = Nolabel ;
1036- typ = {ptyp_desc = Ptyp_constr ({txt = Lident " unit" }, _)};
1037- };
1038- ret = rest;
1039- } ->
1040- get_prop_types types rest
1041- | Ptyp_arrow {arg = {lbl = Nolabel } ; ret = rest } ->
1042- get_prop_types types rest
1043- | Ptyp_arrow {arg; ret = return_value}
1044- when is_optional arg.lbl || is_labelled arg.lbl ->
1045- ( return_value,
1046- (arg.lbl, arg.attrs, return_value.ptyp_loc, arg.typ) :: types )
1047- | _ -> (full_type, types)
1048- in
1049- let inner_type, prop_types = get_prop_types [] pval_type in
1059+ let prop_types = collect_prop_types [] pval_type in
10501060 let named_type_list = List. fold_left arg_to_concrete_type [] prop_types in
10511061 let ret_props_type =
10521062 Typ. constr
@@ -1067,7 +1077,7 @@ let transform_signature_item ~config item =
10671077 let new_external_type =
10681078 Ptyp_constr
10691079 ( {loc = psig_loc; txt = module_access_name config " componentLike" },
1070- [ret_props_type; inner_type ] )
1080+ [ret_props_type; jsx_element_type ~loc: psig_loc ] )
10711081 in
10721082 let new_structure =
10731083 {
0 commit comments