jsx_v4.ml

open! Ast_helper
open Ast_mapper
open Asttypes
open! Parsetree
open Longident

let module_access_name config value =
  String.capitalize_ascii config.Jsx_common.module_ ^ "." ^ value
  |> Longident.parse

let nolabel = Nolabel

let is_optional str =
  match str with
  | Optional _ -> true
  | _ -> false

let is_labelled str =
  match str with
  | Labelled _ -> true
  | _ -> false

let is_forward_ref = function
  | {pexp_desc = Pexp_ident {txt = Ldot (Lident "React", "forwardRef")}} -> true
  | _ -> false

let get_label str =
  match str with
  | Optional {txt = str} | Labelled {txt = str} -> str
  | Nolabel -> ""

let constant_string ~loc str =
  Ast_helper.Exp.constant ~loc (Ast_helper.Const.string str)

let unit_expr ~loc =
  Exp.construct ~loc (Location.mkloc (Lident "()") loc) (Location.mkloc [] loc)

let safe_type_from_value value_str =
  let value_str = get_label value_str in
  if value_str = "" || (value_str.[0] [@doesNotRaise]) <> '_' then value_str
  else "T" ^ value_str

let ref_type_var loc = Typ.var ~loc "ref"

let ref_type loc =
  Typ.constr ~loc
    {loc; txt = Ldot (Ldot (Lident "Stdlib", "Nullable"), "t")}
    [ref_type_var loc]

let jsx_element_type config ~loc =
  Typ.constr ~loc {loc; txt = module_access_name config "element"} []

let jsx_component_expr config ~loc expr =
  Exp.apply ~loc
    (Exp.ident ~loc {loc; txt = module_access_name config "component"})
    [(Nolabel, expr)]

(* Finds the name of the variable the binding is assigned to, otherwise raises Invalid_argument *)
let rec get_fn_name binding =
  match binding with
  | {ppat_desc = Ppat_var {txt}} -> txt
  | {ppat_desc = Ppat_constraint (pat, _)} -> get_fn_name pat
  | {ppat_loc} ->
    Jsx_common.raise_error ~loc:ppat_loc
      "JSX component calls cannot be destructured."

(* Lookup the filename from the location information on the AST node and turn it into a valid module identifier *)
let filename_from_loc (pstr_loc : Location.t) =
  let file_name =
    match pstr_loc.loc_start.pos_fname with
    | "" -> Location.get_input_name ()
    | file_name -> file_name
  in
  let file_name =
    try Filename.chop_extension (Filename.basename file_name)
    with Invalid_argument _ -> file_name
  in
  let file_name = String.capitalize_ascii file_name in
  file_name

(* Build a string representation of a module name with segments separated by $ *)
let make_module_name file_name nested_modules fn_name =
  let full_module_name =
    match (file_name, nested_modules, fn_name) with
    (* TODO: is this even reachable? It seems like the file_name always exists *)
    | "", nested_modules, "make" -> nested_modules
    | "", nested_modules, fn_name -> List.rev (fn_name :: nested_modules)
    | file_name, nested_modules, "make" -> file_name :: List.rev nested_modules
    | file_name, nested_modules, fn_name ->
      file_name :: List.rev (fn_name :: nested_modules)
  in
  let full_module_name = String.concat "$" full_module_name in
  full_module_name

(* make type params for make fn arguments *)
(* let make = ({id, name, children}: props<'id, 'name, 'children>) *)
let make_props_type_params_tvar named_type_list =
  named_type_list
  |> List.filter_map (fun (_isOptional, label, _, loc, _interiorType) ->
      if label = "key" then None
      else
        Some
          (Typ.var ~loc
          @@ safe_type_from_value (Labelled {txt = label; loc = Location.none})
          ))

let strip_option core_type =
  match core_type with
  | {ptyp_desc = Ptyp_constr ({txt = Lident "option"}, core_types)} ->
    List.nth_opt core_types 0 [@doesNotRaise]
  | _ -> Some core_type

let strip_nullable core_type =
  match core_type with
  | {ptyp_desc = Ptyp_constr ({txt = Lident "nullable"}, core_types)}
  | {
      ptyp_desc = Ptyp_constr ({txt = Ldot (Lident "Nullable", "t")}, core_types);
    }
  | {
      ptyp_desc =
        Ptyp_constr
          ({txt = Ldot (Ldot (Lident "Stdlib", "Nullable"), "t")}, core_types);
    } ->
    List.nth_opt core_types 0 [@doesNotRaise]
  | _ -> Some core_type

(* Make type params of the props type *)
(* (Sig) let make: React.componentLike<props<string>, React.element> *)
(* (Str) let make = ({x, _}: props<'x>) => body *)
(* (Str) external make: React.componentLike<props< .. >, React.element> = "default" *)
let make_props_type_params ?(strip_explicit_option = false)
    ?(strip_explicit_nullable_of_ref = false) named_type_list =
  named_type_list
  |> List.filter_map (fun (is_optional, label, _, loc, interior_type) ->
      if label = "key" then
        None (* TODO: Worth thinking how about "ref_" or "_ref" usages *)
      else if label = "ref" then
        (*
                If ref has a type annotation then use it, else 'ref.
                For example, if JSX ppx is used for React Native, type would be different.
             *)
        match interior_type with
        | {ptyp_desc = Ptyp_any} -> Some (ref_type_var loc)
        | _ ->
          if strip_explicit_nullable_of_ref then strip_nullable interior_type
          else Some interior_type
        (* Strip the explicit option type in implementation *)
        (* let make = (~x: option<string>=?) => ... *)
      else if is_optional && strip_explicit_option then
        strip_option interior_type
      else Some interior_type)

let make_label_decls named_type_list =
  let rec check_duplicated_label l =
    let rec mem_label ((_, (la : string), _, _, _) as x) = function
      | [] -> false
      | (_, (lb : string), _, _, _) :: l -> lb = la || mem_label x l
    in
    match l with
    | [] -> ()
    | hd :: tl ->
      if mem_label hd tl then
        let _, label, _, loc, _ = hd in
        Jsx_common.raise_error ~loc
          "The prop `%s` is defined several times in this component." label
      else check_duplicated_label tl
  in
  let () = named_type_list |> List.rev |> check_duplicated_label in

  named_type_list
  |> List.map (fun (is_optional, label, attrs, loc, interior_type) ->
      if label = "key" then
        Type.field ~loc ~attrs ~optional:true {txt = label; loc} interior_type
      else if is_optional then
        Type.field ~loc ~attrs ~optional:true {txt = label; loc}
          (Typ.var @@ safe_type_from_value
          @@ Labelled {txt = label; loc = Location.none})
      else
        Type.field ~loc ~attrs {txt = label; loc}
          (Typ.var @@ safe_type_from_value
          @@ Labelled {txt = label; loc = Location.none}))

let make_type_decls ~attrs props_name loc named_type_list =
  let label_decl_list = make_label_decls named_type_list in
  (* 'id, 'className, ... *)
  let params =
    make_props_type_params_tvar named_type_list
    |> List.map (fun core_type -> (core_type, Invariant))
  in
  [
    Type.mk ~attrs ~loc ~params {txt = props_name; loc}
      ~kind:(Ptype_record label_decl_list);
  ]

let make_type_decls_with_core_type props_name loc core_type typ_vars =
  [
    Type.mk ~loc {txt = props_name; loc} ~kind:Ptype_abstract
      ~params:(typ_vars |> List.map (fun v -> (v, Invariant)))
      ~manifest:core_type;
  ]

let live_attr = ({txt = "live"; loc = Location.none}, PStr [])
let jsx_component_props_attr =
  ({txt = "res.jsxComponentProps"; loc = Location.none}, PStr [])

(* type props<'x, 'y, ...> = { x: 'x, y?: 'y, ... } *)
let make_props_record_type ~core_type_of_attr ~external_ ~typ_vars_of_core_type
    props_name loc named_type_list =
  let attrs =
    if external_ then [jsx_component_props_attr; live_attr]
    else [jsx_component_props_attr]
  in
  Str.type_ Nonrecursive
    (match core_type_of_attr with
    | None -> make_type_decls ~attrs props_name loc named_type_list
    | Some core_type ->
      make_type_decls_with_core_type props_name loc core_type
        typ_vars_of_core_type)

(* type props<'x, 'y, ...> = { x: 'x, y?: 'y, ... } *)
let make_props_record_type_sig ~core_type_of_attr ~external_
    ~typ_vars_of_core_type props_name loc named_type_list =
  let attrs =
    if external_ then [jsx_component_props_attr; live_attr]
    else [jsx_component_props_attr]
  in
  Sig.type_ Nonrecursive
    (match core_type_of_attr with
    | None -> make_type_decls ~attrs props_name loc named_type_list
    | Some core_type ->
      make_type_decls_with_core_type props_name loc core_type
        typ_vars_of_core_type)

let rec recursively_transform_named_args_for_make expr args newtypes core_type =
  match expr.pexp_desc with
  | Pexp_fun {newtypes = fun_newtypes; params; body} ->
    (* Collected newtypes are accumulated in reverse source order. *)
    let newtypes = List.rev_append fun_newtypes newtypes in
    transform_params_for_make ~expr ~body params args newtypes core_type
  | Pexp_constraint (expression, core_type) ->
    recursively_transform_named_args_for_make expression args newtypes
      (Some core_type)
  | _ -> (args, newtypes, core_type)

and transform_params_for_make ~expr ~body params args newtypes core_type =
  match params with
  | [] ->
    (* all parameters of this function consumed: keep walking into the body,
       as the legacy chain walk did *)
    recursively_transform_named_args_for_make body args newtypes core_type
  (* TODO: make this show up with a loc. *)
  | {p_lbl = Labelled {txt = "key"} | Optional {txt = "key"}} :: _ ->
    Jsx_common.raise_error ~loc:expr.pexp_loc
      "Key cannot be accessed inside of a component. Don't worry - you can \
       always key a component from its parent!"
  | {p_lbl = arg; p_default = default; p_pat = pattern} :: rest
    when is_optional arg || is_labelled arg ->
    let () =
      match (is_optional arg, pattern, default) with
      | true, {ppat_desc = Ppat_constraint (_, {ptyp_desc})}, None -> (
        match ptyp_desc with
        | Ptyp_constr ({txt = Lident "option"}, [_]) -> ()
        | _ ->
          let current_type =
            match ptyp_desc with
            | Ptyp_constr ({txt}, []) ->
              String.concat "." (Longident.flatten txt)
            | Ptyp_constr ({txt}, _innerTypeArgs) ->
              String.concat "." (Longident.flatten txt) ^ "(...)"
            | _ -> "..."
          in
          Location.prerr_warning pattern.ppat_loc
            (Preprocessor
               (Printf.sprintf
                  "React: optional argument annotations must have explicit \
                   `option`. Did you mean `option<%s>=?`?"
                  current_type)))
      | _ -> ()
    in
    let alias =
      match pattern with
      | {
       ppat_desc =
         ( Ppat_alias (_, {txt})
         | Ppat_var {txt}
         | Ppat_constraint ({ppat_desc = Ppat_var {txt}}, _) );
      } ->
        txt
      | {ppat_desc = Ppat_any} -> "_"
      | _ -> get_label arg
    in
    let type_ =
      match pattern with
      | {ppat_desc = Ppat_constraint (_, {ptyp_desc = Ptyp_package _})} -> None
      | {ppat_desc = Ppat_constraint (_, type_)} -> Some type_
      | _ -> None
    in

    transform_params_for_make ~expr ~body rest
      ((arg, default, pattern, alias, pattern.ppat_loc, type_) :: args)
      newtypes core_type
  | {
      p_lbl = Nolabel;
      p_pat = {ppat_desc = Ppat_construct ({txt = Lident "()"}, _) | Ppat_any};
    }
    :: _ ->
    (args, newtypes, core_type)
  | {
      p_lbl = Nolabel;
      p_pat =
        {
          ppat_desc =
            Ppat_var {txt} | Ppat_constraint ({ppat_desc = Ppat_var {txt}}, _);
        } as pattern;
    }
    :: _ ->
    if txt = "ref" then
      let type_ =
        match pattern with
        | {ppat_desc = Ppat_constraint (_, type_)} -> Some type_
        | _ -> None
      in
      (* The ref arguement of forwardRef should be optional *)
      ( ( Optional {txt = "ref"; loc = Location.none},
          None,
          pattern,
          txt,
          pattern.ppat_loc,
          type_ )
        :: args,
        newtypes,
        core_type )
    else (args, newtypes, core_type)
  | {p_lbl = Nolabel; p_pat = pattern} :: _ ->
    Location.raise_errorf ~loc:pattern.ppat_loc
      "React: react.component refs only support plain arguments and type \
       annotations."
  | _ :: _ -> (args, newtypes, core_type)

let arg_to_type types
    ((name, default, {ppat_attributes = attrs}, _alias, loc, type_) :
      arg_label * expression option * pattern * label * 'loc * core_type option)
    =
  match (type_, name, default) with
  | Some type_, name, _ when is_optional name ->
    (true, get_label name, attrs, loc, type_) :: types
  | Some type_, name, _ -> (false, get_label name, attrs, loc, type_) :: types
  | None, name, _ when is_optional name ->
    (true, get_label name, attrs, loc, Typ.any ~loc ()) :: types
  | None, name, _ when is_labelled name ->
    (false, get_label name, attrs, loc, Typ.any ~loc ()) :: types
  | _ -> types

let has_default_value name_arg_list =
  name_arg_list
  |> List.exists (fun (name, default, _, _, _, _) ->
      Option.is_some default && is_optional name)

let arg_to_concrete_type types (name, attrs, loc, type_) =
  match name with
  | name when is_labelled name ->
    (false, get_label name, attrs, loc, type_) :: types
  | name when is_optional name ->
    (true, get_label name, attrs, loc, type_) :: types
  | _ -> types

let check_string_int_attribute_iter =
  let attribute _ ({txt; loc}, _) =
    if txt = "string" || txt = "int" then
      Jsx_common.raise_error ~loc
        "@string and @int attributes not supported. See \
         https://github.com/rescript-lang/rescript-compiler/issues/5724"
  in

  {Ast_iterator.default_iterator with attribute}

let check_multiple_components ~config ~loc =
  (* If there is another component, throw error *)
  if config.Jsx_common.has_component then
    Jsx_common.raise_error_multiple_component ~loc
  else config.has_component <- true

(* Find the final function through expression wrappers. Applications are only
   followed when inspecting component wrappers such as forwardRef and memo. *)
let rec find_function_expression ~through_application expression =
  match expression.pexp_desc with
  | Pexp_fun _ -> Ok expression
  | Pexp_braces {expr = inner} | Pexp_constraint (inner, _) ->
    find_function_expression ~through_application inner
  | Pexp_let (_, _, body) | Pexp_sequence (_, body) ->
    find_function_expression ~through_application body
  | Pexp_apply {args = [(Nolabel, inner)]} when through_application ->
    find_function_expression ~through_application inner
  | _ -> Error expression

let is_function_expression expression =
  match find_function_expression ~through_application:false expression with
  | Ok _ -> true
  | Error _ -> false

let modified_binding_old binding =
  (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *)
  match find_function_expression ~through_application:true binding.pvb_expr with
  | Ok expression -> expression
  | Error {pexp_loc} ->
    Jsx_common.raise_error ~loc:pexp_loc
      "JSX component calls can only be on function definitions or component \
       wrappers (forwardRef, memo)."

let modified_binding ~binding_loc ~binding_pat_loc ~fn_name binding =
  let has_application = ref false in
  let wrap_expression_with_binding expression_fn expression =
    Vb.mk ~loc:binding_loc ~attrs:binding.pvb_attributes
      (Pat.var ~loc:binding_pat_loc {loc = binding_pat_loc; txt = fn_name})
      (expression_fn expression)
  in
  let expression = binding.pvb_expr in
  (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *)
  let rec spelunk_for_fun_expression expression =
    match expression with
    | {pexp_desc = Pexp_braces {expr = inner}} ->
      spelunk_for_fun_expression inner
    (* let make = (()) => ... *)
    (* let make = (_) => ... *)
    | {
     pexp_desc =
       Pexp_fun
         {
           params =
             {
               p_lbl = Nolabel;
               p_pat =
                 {
                   ppat_desc = Ppat_construct ({txt = Lident "()"}, _) | Ppat_any;
                 };
             }
             :: _;
         };
    } ->
      ((fun a -> a), false, expression)
    (* let make = (~prop) => ... *)
    | {pexp_desc = Pexp_fun {params = {p_lbl = Labelled _ | Optional _} :: _}}
      ->
      ((fun a -> a), false, expression)
    (* let make = (prop) => ... *)
    | {pexp_desc = Pexp_fun {params = {p_pat = pattern} :: _}} ->
      if !has_application then ((fun a -> a), false, expression)
      else
        Location.raise_errorf ~loc:pattern.ppat_loc
          "React: props need to be labelled arguments.\n\
          \  If you are working with refs be sure to wrap with React.forwardRef.\n\
          \  If your component doesn't have any props use () or _ instead of a \
           name."
    (* let make = {let foo = bar in (~prop) => ...} *)
    | {pexp_desc = Pexp_let (recursive, vbs, internal_expression)} ->
      (* here's where we spelunk! *)
      let wrap, has_forward_ref, exp =
        spelunk_for_fun_expression internal_expression
      in
      ( wrap,
        has_forward_ref,
        {expression with pexp_desc = Pexp_let (recursive, vbs, exp)} )
    (* let make = React.forwardRef((~prop) => ...) *)
    | {
     pexp_desc =
       Pexp_apply
         {funct = wrapper_expression; args = [(Nolabel, internal_expression)]};
    } ->
      let () = has_application := true in
      let _, _, exp = spelunk_for_fun_expression internal_expression in
      let has_forward_ref = is_forward_ref wrapper_expression in
      ( (fun exp -> Exp.apply wrapper_expression [(nolabel, exp)]),
        has_forward_ref,
        exp )
    | {pexp_desc = Pexp_sequence (wrapper_expression, internal_expression)} ->
      let wrap, has_forward_ref, exp =
        spelunk_for_fun_expression internal_expression
      in
      ( wrap,
        has_forward_ref,
        {expression with pexp_desc = Pexp_sequence (wrapper_expression, exp)} )
    | e -> ((fun a -> a), false, e)
  in
  let wrap_expression, has_forward_ref, expression =
    spelunk_for_fun_expression expression
  in
  (wrap_expression_with_binding wrap_expression, has_forward_ref, expression)

let rec strip_constraint_unpack pattern =
  match pattern with
  | {ppat_desc = Ppat_constraint (_, {ptyp_desc = Ptyp_package _})} -> pattern
  | {ppat_desc = Ppat_constraint (pattern, _)} ->
    strip_constraint_unpack pattern
  | _ -> pattern

let vb_match ~expr (name, default, pattern, _alias, loc, _) =
  let label = get_label name in
  match default with
  | Some default ->
    let resolved_name = "__" ^ label ^ "_value" in
    let value_binding =
      Vb.mk
        (Pat.var (Location.mkloc resolved_name loc))
        (Exp.match_
           (Exp.ident {txt = Lident ("__" ^ label); loc = Location.none})
           [
             Exp.case
               (Pat.construct
                  (Location.mknoloc @@ Lident "Some")
                  (Location.mknoloc [Pat.var (Location.mknoloc label)]))
               (Exp.ident (Location.mknoloc @@ Lident label));
             Exp.case
               (Pat.construct
                  (Location.mknoloc @@ Lident "None")
                  (Location.mknoloc []))
               default;
           ])
    in
    Exp.let_ Nonrecursive [value_binding]
      (Exp.let_ Nonrecursive
         [Vb.mk pattern (Exp.ident (Location.mknoloc @@ Lident resolved_name))]
         expr)
  | None -> expr

let vb_match_expr named_arg_list expr =
  let rec aux named_arg_list =
    match named_arg_list with
    | [] -> expr
    | named_arg :: rest -> vb_match named_arg ~expr:(aux rest)
  in
  aux (List.rev named_arg_list)

let map_binding ~config ~empty_loc ~pstr_loc ~file_name binding =
  (* Traverse the component body and force every reachable return expression to
   be annotated as `Jsx.element`. This walks through the wrapper constructs the
   PPX introduces (fun/newtype/let/sequence) so that the constraint ends up on
   the real return position even after we rewrite the function. *)
  let rec constrain_jsx_return expr =
    let jsx_element_constraint expr =
      Exp.constraint_ expr (jsx_element_type config ~loc:expr.pexp_loc)
    in
    match expr.pexp_desc with
    | Pexp_braces {expr = inner; braces_loc} when is_function_expression inner
      ->
      {
        expr with
        pexp_desc = Pexp_braces {expr = constrain_jsx_return inner; braces_loc};
      }
    | Pexp_fun ({body} as desc) ->
      {
        expr with
        pexp_desc = Pexp_fun {desc with body = constrain_jsx_return body};
      }
    | Pexp_constraint (inner, _) ->
      let constrained_inner = constrain_jsx_return inner in
      jsx_element_constraint constrained_inner
    | Pexp_let (rec_flag, bindings, body) ->
      {
        expr with
        pexp_desc = Pexp_let (rec_flag, bindings, constrain_jsx_return body);
      }
    | Pexp_sequence (first, second) ->
      {expr with pexp_desc = Pexp_sequence (first, constrain_jsx_return second)}
    | _ -> jsx_element_constraint expr
  in
  let pvb_jsx_component, pvb_attributes =
    Jsx_common.take_component_with_props_payload binding.pvb_jsx_component
      binding.pvb_attributes
  in
  let binding = {binding with pvb_jsx_component; pvb_attributes} in
  Jsx_common.reject_leftover_component_attrs binding.pvb_attributes;
  match binding.pvb_jsx_component with
  | Some {pjc_kind = Pjc_labelled core_type_of_attr} ->
    check_multiple_components ~config ~loc:pstr_loc;
    let binding_newtypes, binding_core_type =
      match binding.pvb_constraint with
      | None -> ([], None)
      | Some {pvc_newtypes; pvc_type} ->
        (List.rev_map (fun name -> (name, [])) pvc_newtypes, Some pvc_type)
    in
    let typ_vars_of_core_type =
      core_type_of_attr
      |> Option.map Jsx_common.typ_vars_of_core_type
      |> Option.value ~default:[]
    in
    let binding_loc = binding.pvb_loc in
    let binding_pat_loc = binding.pvb_pat.ppat_loc in
    let binding =
      {
        binding with
        pvb_pat = {binding.pvb_pat with ppat_loc = empty_loc};
        pvb_constraint = None;
        pvb_loc = empty_loc;
        pvb_jsx_component = None;
      }
    in
    let fn_name = get_fn_name binding.pvb_pat in
    let full_module_name =
      make_module_name file_name config.nested_modules fn_name
    in
    let binding_wrapper, has_forward_ref, expression =
      modified_binding ~binding_loc ~binding_pat_loc ~fn_name binding
    in
    let is_async = Ast_async.dig_async_payload_from_function binding.pvb_expr in
    let named_arg_list, newtypes, _typeConstraints =
      recursively_transform_named_args_for_make
        (modified_binding_old binding)
        [] binding_newtypes binding_core_type
    in
    let named_type_list = List.fold_left arg_to_type [] named_arg_list in
    (* type props = { ... } *)
    let props_record_type =
      make_props_record_type ~core_type_of_attr ~external_:false
        ~typ_vars_of_core_type "props" pstr_loc named_type_list
    in
    let inner_expression =
      Exp.apply
        (Exp.ident (Location.mknoloc @@ Lident fn_name))
        ([(Nolabel, Exp.ident (Location.mknoloc @@ Lident "props"))]
        @
        match has_forward_ref with
        | true -> [(Nolabel, Exp.ident (Location.mknoloc @@ Lident "ref"))]
        | false -> [])
    in
    let make_props_pattern = function
      | [] -> Pat.var @@ Location.mknoloc "props"
      | _ ->
        Pat.constraint_
          (Pat.var @@ Location.mknoloc "props")
          (Typ.constr (Location.mknoloc @@ Lident "props") [Typ.any ()])
    in
    let inner_expression =
      Jsx_common.async_component ~async:is_async inner_expression
    in
    let full_expression =
      (* React component name should start with uppercase letter *)
      (* let make = { let \"App" = props => make(props); \"App" } *)
      (* let make = React.forwardRef({
           let \"App" = (props, ref) => make({...props, ref: @optional (Stdlib.Nullable.toOption(ref))})
         })*)
      let props_param =
        Exp.fun_param Nolabel
          (match core_type_of_attr with
          | None -> make_props_pattern named_type_list
          | Some _ -> make_props_pattern typ_vars_of_core_type)
      in
      let params =
        if has_forward_ref then
          [
            props_param;
            Exp.fun_param Nolabel (Pat.var @@ Location.mknoloc "ref");
          ]
        else [props_param]
      in
      Exp.fun_ ~attrs:binding.pvb_expr.pexp_attributes params inner_expression
    in
    let full_expression =
      match full_module_name with
      | "" -> full_expression
      | txt ->
        Exp.let_ Nonrecursive
          [
            Vb.mk ~loc:empty_loc
              (Pat.var ~loc:empty_loc {loc = empty_loc; txt})
              full_expression;
          ]
          (Exp.ident ~loc:pstr_loc {loc = empty_loc; txt = Lident txt})
    in
    (* Build a plain function first, then coerce that function to the abstract
       component type:

         let make = React.component({
           let "File$Component" = props => make(props)
           "File$Component"
         })

       Putting the coercion directly around the function argument, as in
       `React.component(props => make(props))`, hides the function under an
       application during typing and breaks inference for polymorphic props.
       The typechecker treats this `%component_identity` coercion as non-expansive, so
       the inferred prop type can still be generalized. *)
    let full_expression =
      if has_forward_ref then full_expression
      else jsx_component_expr config ~loc:empty_loc full_expression
    in
    let rec returned_expression patterns_with_label patterns_with_nolabel
        ({pexp_desc} as expr) =
      match pexp_desc with
      | Pexp_constraint (expr, _) ->
        returned_expression patterns_with_label patterns_with_nolabel expr
      | Pexp_fun {params; body} ->
        returned_expression_params patterns_with_label patterns_with_nolabel
          params body
      | _ -> (patterns_with_label, patterns_with_nolabel, expr)
    and returned_expression_params patterns_with_label patterns_with_nolabel
        params body =
      match params with
      | [] -> returned_expression patterns_with_label patterns_with_nolabel body
      | {p_pat = {ppat_desc = Ppat_construct ({txt = Lident "()"}, _)}} :: rest
        ->
        let remainder =
          match rest with
          | [] -> body
          | _ -> Ast_helper.Exp.fun_ rest body
        in
        (patterns_with_label, patterns_with_nolabel, remainder)
      | {
          p_lbl = arg_label;
          p_default = default;
          p_pat = {ppat_loc; ppat_desc} as pattern;
        }
        :: rest -> (
        let pattern_without_constraint = strip_constraint_unpack pattern in
        (*
           If prop has the default value as Ident, it will get a build error
           when the referenced Ident value and the prop have the same name.
           So we bind a temp "__<label>" in the props pattern and destructure
           the original pattern later after resolving the default.
        *)
        let pattern_with_safe_label =
          match default with
          | Some _ ->
            Pat.var
              (Location.mkloc
                 ("__" ^ get_label arg_label)
                 pattern_without_constraint.ppat_loc)
          | _ -> pattern_without_constraint
        in
        if is_labelled arg_label || is_optional arg_label then
          returned_expression_params
            ({
               lid = {loc = ppat_loc; txt = Lident (get_label arg_label)};
               x =
                 {
                   pattern_with_safe_label with
                   ppat_attributes = pattern.ppat_attributes;
                 };
               opt = is_optional arg_label;
             }
            :: patterns_with_label)
            patterns_with_nolabel rest body
        else
          (* Special case of nolabel arg "ref" in forwardRef fn *)
          (* let make = React.forwardRef(ref => body) *)
          match ppat_desc with
          | Ppat_var {txt} | Ppat_constraint ({ppat_desc = Ppat_var {txt}}, _)
            ->
            returned_expression_params patterns_with_label
              (( {loc = ppat_loc; txt = Lident txt},
                 {pattern with ppat_attributes = pattern.ppat_attributes},
                 true )
              :: patterns_with_nolabel)
              rest body
          | _ ->
            returned_expression_params patterns_with_label patterns_with_nolabel
              rest body)
    in
    let patterns_with_label, patterns_with_nolabel, expression =
      returned_expression [] [] expression
    in
    (* add pattern matching for optional prop value *)
    let expression =
      if has_default_value named_arg_list then
        vb_match_expr named_arg_list expression
      else expression
    in
    let expression = constrain_jsx_return expression in
    (* (ref) => expr *)
    let nolabel_params =
      patterns_with_nolabel
      |> List.rev_map (fun (_, pattern, _opt) ->
          let pattern =
            match pattern.ppat_desc with
            | Ppat_var {txt} when txt = "ref" ->
              Pat.constraint_ pattern (ref_type Location.none)
            | _ -> pattern
          in
          Exp.fun_param Nolabel pattern)
    in
    (* ({a, b, _}: props<'a, 'b>) *)
    let record_pattern =
      match patterns_with_label with
      | [] -> Pat.any ()
      | _ -> Pat.record (List.rev patterns_with_label) Open
    in
    let expression =
      (* Shape internal implementation to match wrapper: uncurried when using forwardRef. *)
      let props_param =
        Exp.fun_param Nolabel
          (Pat.constraint_ record_pattern
             (Typ.constr ~loc:empty_loc
                {txt = Lident "props"; loc = empty_loc}
                (match core_type_of_attr with
                | None ->
                  make_props_type_params ~strip_explicit_option:true
                    ~strip_explicit_nullable_of_ref:has_forward_ref
                    named_type_list
                | Some _ -> (
                  match typ_vars_of_core_type with
                  | [] -> []
                  | _ -> [Typ.any ()]))))
      in
      (* Add the collected newtypes (type a b c) to make's definition *)
      Exp.fun_ ~async:is_async ~newtypes:(List.rev newtypes)
        (props_param :: nolabel_params)
        expression
    in
    (* let make = ({id, name, ...}: props<'id, 'name, ...>) => { ... } *)
    let binding =
      {
        binding with
        pvb_expr = expression;
        pvb_pat = Pat.var {txt = fn_name; loc = Location.none};
      }
    in
    let new_binding = Some (binding_wrapper full_expression) in
    (Some props_record_type, binding, new_binding)
  | Some {pjc_kind = Pjc_with_props} ->
    let modified_binding = {binding with pvb_jsx_component = None} in
    let fn_name = get_fn_name modified_binding.pvb_pat in
    let full_module_name =
      make_module_name file_name config.nested_modules fn_name
    in

    let is_async =
      Ast_async.dig_async_payload_from_function modified_binding.pvb_expr
    in

    let make_new_binding ~loc ~full_module_name binding =
      let props_pattern =
        match binding.pvb_expr with
        | {
         pexp_desc =
           Pexp_apply {funct = wrapper_expr; args = [(Nolabel, func_expr)]};
        }
          when is_forward_ref wrapper_expr ->
          (* Case when using React.forwardRef *)
          let rec check_invalid_forward_ref expr =
            match expr.pexp_desc with
            | Pexp_fun {params; body} ->
              if
                List.exists
                  (fun {p_lbl} ->
                    match p_lbl with
                    | Labelled _ | Optional _ -> true
                    | Nolabel -> false)
                  params
              then
                Location.raise_errorf ~loc:expr.pexp_loc
                  "Components using React.forwardRef cannot use \
                   @react.componentWithProps. Use @react.component instead."
              else check_invalid_forward_ref body
            | _ -> ()
          in
          check_invalid_forward_ref func_expr;
          Pat.var {txt = "props"; loc}
        | {
         pexp_desc =
           Pexp_fun
             {params = {p_pat = {ppat_desc = Ppat_constraint (_, typ)}} :: _};
        } -> (
          match typ with
          | {ptyp_desc = Ptyp_constr ({txt = Lident "props"}, args)} ->
            (* props<_> *)
            if List.length args > 0 then
              Pat.constraint_
                (Pat.var {txt = "props"; loc})
                (Typ.constr {txt = Lident "props"; loc} [Typ.any ()])
              (* props *)
            else
              Pat.constraint_
                (Pat.var {txt = "props"; loc})
                (Typ.constr {txt = Lident "props"; loc} [])
          | _ -> Pat.var {txt = "props"; loc})
        | _ -> Pat.var {txt = "props"; loc}
      in
      let applied_expression =
        Exp.apply
          (Exp.ident {txt = Lident fn_name; loc})
          [(Nolabel, Exp.ident {txt = Lident "props"; loc})]
      in
      let applied_expression =
        Jsx_common.async_component ~async:is_async applied_expression
      in
      let applied_expression = constrain_jsx_return applied_expression in
      let wrapper_expr =
        Exp.fun_ ~attrs:binding.pvb_expr.pexp_attributes
          [Exp.fun_param Nolabel props_pattern]
          applied_expression
      in
      let internal_expression =
        Exp.let_ Nonrecursive
          [Vb.mk (Pat.var {txt = full_module_name; loc}) wrapper_expr]
          (Exp.ident {txt = Lident full_module_name; loc})
      in
      let internal_expression =
        jsx_component_expr config ~loc internal_expression
      in

      Vb.mk ~attrs:modified_binding.pvb_attributes
        (Pat.var {txt = fn_name; loc})
        internal_expression
    in

    let new_binding =
      Some (make_new_binding ~loc:empty_loc ~full_module_name modified_binding)
    in
    let binding_expr =
      {
        binding.pvb_expr with
        (* moved to wrapper_expr *)
        pexp_attributes = [];
      }
    in
    ( None,
      {
        binding with
        pvb_jsx_component = None;
        pvb_expr = binding_expr |> constrain_jsx_return;
      },
      new_binding )
  | None -> (None, binding, None)

let rec collect_prop_types types {ptyp_desc} =
  match ptyp_desc with
  | Ptyp_arrow {params; ret} ->
    let ret_is_arrow =
      match ret.ptyp_desc with
      | Ptyp_arrow _ -> true
      | _ -> false
    in
    let rec go types = function
      | [] -> if ret_is_arrow then collect_prop_types types ret else types
      | Parsetree.Parg_type {lbl; attrs; typ} :: rest
        when is_labelled lbl || is_optional lbl ->
        let loc =
          match (rest, ret_is_arrow) with
          | [], false -> ret.ptyp_loc
          | _ -> typ.ptyp_loc
        in
        go ((lbl, attrs, loc, typ) :: types) rest
      | (Parsetree.Parg_type _ | Parsetree.Parg_fixed _) :: rest ->
        go types rest
    in
    go types params
  | _ -> types

let transform_structure_item ~config item =
  match item with
  (* external *)
  | {
      pstr_loc;
      pstr_desc =
        Pstr_primitive ({pval_attributes; pval_type} as value_description);
    } as pstr -> (
    let pval_jsx_component, pval_attributes =
      Jsx_common.take_component_with_props_payload
        value_description.pval_jsx_component pval_attributes
    in
    Jsx_common.reject_leftover_component_attrs pval_attributes;
    match pval_jsx_component with
    | None -> [item]
    | Some {pjc_kind = Pjc_with_props} ->
      Jsx_common.raise_error ~loc:pstr_loc
        "Components cannot be defined as externals when using \
         @react.componentWithProps.\n\n\
         If you intended to define an external for a React component using a \
         props type,\n\
         use the type React.component<props> instead.\n\
         Alternatively, use @react.component for an external definition with \
         labeled arguments."
    | Some {pjc_kind = Pjc_labelled core_type_of_attr} ->
      check_multiple_components ~config ~loc:pstr_loc;
      check_string_int_attribute_iter.structure_item
        check_string_int_attribute_iter item;
      let typ_vars_of_core_type =
        core_type_of_attr
        |> Option.map Jsx_common.typ_vars_of_core_type
        |> Option.value ~default:[]
      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 ret_props_type =
        Typ.constr ~loc:pstr_loc
          (Location.mkloc (Lident "props") pstr_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 ()]))
      in
      (* type props<'x, 'y> = { x: 'x, y?: 'y, ... } *)
      let props_record_type =
        make_props_record_type ~core_type_of_attr ~external_:true
          ~typ_vars_of_core_type "props" pstr_loc named_type_list
      in
      (* can't be an arrow because it will defensively uncurry *)
      let new_external_type =
        Ptyp_constr
          ( {loc = pstr_loc; txt = module_access_name config "component"},
            [ret_props_type] )
      in
      let new_structure =
        {
          pstr with
          pstr_desc =
            Pstr_primitive
              {
                value_description with
                pval_type = {pval_type with ptyp_desc = new_external_type};
                pval_jsx_component = None;
              };
        }
      in
      [props_record_type; new_structure])
  (* let component = ... *)
  | {pstr_loc; pstr_desc = Pstr_value (rec_flag, value_bindings)} -> (
    let file_name = filename_from_loc pstr_loc in
    let empty_loc = Location.in_file file_name in
    let process_binding binding (new_items, bindings, new_bindings) =
      let new_item, binding, new_binding =
        map_binding ~config ~empty_loc ~pstr_loc ~file_name binding
      in
      let new_items =
        match new_item with
        | Some item -> item :: new_items
        | None -> new_items
      in
      let new_bindings =
        match new_binding with
        | Some new_binding -> new_binding :: new_bindings
        | None -> new_bindings
      in
      (new_items, binding :: bindings, new_bindings)
    in
    let new_items, bindings, new_bindings =
      List.fold_right process_binding value_bindings ([], [], [])
    in
    new_items
    @ [{pstr_loc; pstr_desc = Pstr_value (rec_flag, bindings)}]
    @
    match new_bindings with
    | [] -> []
    | new_bindings ->
      [
        {
          pstr_loc = empty_loc;
          pstr_desc = Pstr_value (Nonrecursive, new_bindings);
        };
      ])
  | _ -> [item]

let transform_signature_item ~config item =
  match item with
  | {
      psig_loc;
      psig_desc = Psig_value ({pval_attributes; pval_type} as psig_desc);
    } as psig -> (
    let pval_jsx_component, pval_attributes =
      Jsx_common.take_component_with_props_payload psig_desc.pval_jsx_component
        pval_attributes
    in
    Jsx_common.reject_leftover_component_attrs pval_attributes;
    match pval_jsx_component with
    (* [@react.componentWithProps] on a signature item has always been left
       alone. *)
    | None | Some {pjc_kind = Pjc_with_props} -> [item]
    | Some {pjc_kind = Pjc_labelled core_type_of_attr} ->
      check_multiple_components ~config ~loc:psig_loc;
      check_string_int_attribute_iter.signature_item
        check_string_int_attribute_iter item;
      let typ_vars_of_core_type =
        core_type_of_attr
        |> Option.map Jsx_common.typ_vars_of_core_type
        |> Option.value ~default:[]
      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 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 ()]))
      in
      let external_ = psig_desc.pval_prim <> None in
      let props_record_type =
        make_props_record_type_sig ~core_type_of_attr ~external_
          ~typ_vars_of_core_type "props" psig_loc named_type_list
      in
      (* can't be an arrow because it will defensively uncurry *)
      let new_external_type =
        Ptyp_constr
          ( {loc = psig_loc; txt = module_access_name config "component"},
            [ret_props_type] )
      in
      let new_structure =
        {
          psig with
          psig_desc =
            Psig_value
              {
                psig_desc with
                pval_type = {pval_type with ptyp_desc = new_external_type};
                pval_jsx_component = None;
              };
        }
      in
      [props_record_type; new_structure])
  | _ -> [item]

(* There appear to be slightly different rules of transformation whether the component is upper-, lowercase or a fragment *)
type component_description =
  | LowercasedComponent
  | UppercasedComponent
  | FragmentComponent

let loc_from_prop = function
  | JSXPropPunning (_, name) -> name.loc
  | JSXPropValue (name, _, value) ->
    {name.loc with loc_end = value.pexp_loc.loc_end}
  | JSXPropSpreading (loc, _) -> loc

let mk_record_from_props mapper (jsx_expr_loc : Location.t) (props : jsx_props)
    : expression =
  (* Create an artificial range from the first till the last prop *)
  let loc =
    match props with
    | [] -> jsx_expr_loc
    | head :: tail ->
      let rec visit props =
        match props with
        | [] -> head
        | [last] -> last
        | _ :: rest -> visit rest
      in
      let first_item = head |> loc_from_prop in
      let last_item = visit tail |> loc_from_prop in
      {
        loc_start = first_item.loc_start;
        loc_end = last_item.loc_end;
        loc_ghost = false;
      }
  in
  (* key should be filtered out *)
  let props =
    props
    |> List.filter (function
      | JSXPropPunning (_, {txt = "key"}) | JSXPropValue ({txt = "key"}, _, _)
        ->
        false
      | _ -> true)
  in
  let props, spread_props =
    match props with
    | JSXPropSpreading (_, expr) :: rest ->
      (rest, Some (mapper.expr mapper expr))
    | _ -> (props, None)
  in

  let record_fields =
    props
    |> List.map (function
      | JSXPropPunning (is_optional, name) ->
        {
          lid = {txt = Lident name.txt; loc = name.loc};
          x = Exp.ident ~loc:name.loc {txt = Lident name.txt; loc = name.loc};
          opt = is_optional;
        }
      | JSXPropValue (name, is_optional, value) ->
        {
          lid = {txt = Lident name.txt; loc = name.loc};
          x = mapper.expr mapper value;
          opt = is_optional;
        }
      | JSXPropSpreading (loc, _) ->
        (* There can only be one spread expression and it is expected to be the first prop *)
        Jsx_common.raise_error ~loc
          "JSX: use {...p} {x: v} not {x: v} {...p} \n\
          \     multiple spreads {...p} {...p} not allowed.")
  in
  match (record_fields, spread_props) with
  | [], Some spread_props ->
    {pexp_desc = spread_props.pexp_desc; pexp_loc = loc; pexp_attributes = []}
  | record_fields, spread_props ->
    {
      pexp_desc = Pexp_record (record_fields, spread_props);
      pexp_loc = loc;
      pexp_attributes = [];
    }

let try_find_key_prop (props : jsx_props) : (arg_label * expression) option =
  props
  |> List.find_map (function
    | JSXPropPunning (is_optional, ({txt = "key"} as name)) ->
      let arg_label = if is_optional then Optional name else Labelled name in
      Some (arg_label, Exp.ident {txt = Lident "key"; loc = name.loc})
    | JSXPropValue (({txt = "key"} as name), is_optional, expr) ->
      let arg_label = if is_optional then Optional name else Labelled name in
      Some (arg_label, expr)
    | _ -> None)

let append_children_prop (config : Jsx_common.jsx_config) mapper
    (component_description : component_description) (props : jsx_props)
    (children : jsx_children) : jsx_props =
  match children with
  | [] -> props
  | [child] ->
    let expr =
      (* I don't quite know why fragment and uppercase don't do this additional ReactDOM.someElement wrapping *)
      match component_description with
      | FragmentComponent | UppercasedComponent -> mapper.expr mapper child
      | LowercasedComponent ->
        let element_binding =
          match config.module_ |> String.lowercase_ascii with
          | "react" -> Lident "ReactDOM"
          | _generic -> module_access_name config "Elements"
        in
        Exp.apply
          (Exp.ident
             {txt = Ldot (element_binding, "someElement"); loc = Location.none})
          [(Nolabel, mapper.expr mapper child)]
    in
    let is_optional =
      match component_description with
      | LowercasedComponent -> true
      | FragmentComponent | UppercasedComponent -> false
    in
    props
    @ [
        JSXPropValue
          ({txt = "children"; loc = child.pexp_loc}, is_optional, expr);
      ]
  | head :: _ as xs ->
    let loc =
      match List.rev xs with
      | [] -> head.pexp_loc
      | last_child :: _ ->
        {head.pexp_loc with loc_end = last_child.pexp_loc.loc_end}
    in
    (* this is a hack to support react components that introspect into their children *)
    props
    @ [
        JSXPropValue
          ( {txt = "children"; loc},
            false,
            Exp.apply ~loc
              (Exp.ident {txt = module_access_name config "array"; loc})
              [(Nolabel, Exp.array (List.map (mapper.expr mapper) xs))] );
      ]

let mk_react_jsx (config : Jsx_common.jsx_config) mapper loc attrs
    (component_description : component_description) (element_tag : expression)
    (props : jsx_props) (children : jsx_children) : expression =
  let more_than_one_children = List.length children > 1 in
  let props_with_children =
    append_children_prop config mapper component_description props children
  in
  let props_record = mk_record_from_props mapper loc props_with_children in
  let jsx_expr, key_and_unit =
    let mk_element_bind (jsx_part : string) : Longident.t =
      match component_description with
      | FragmentComponent | UppercasedComponent ->
        module_access_name config jsx_part
      | LowercasedComponent ->
        let element_binding =
          match config.module_ |> String.lowercase_ascii with
          | "react" -> Lident "ReactDOM"
          | _generic -> module_access_name config "Elements"
        in
        Ldot (element_binding, jsx_part)
    in
    match try_find_key_prop props with
    | None ->
      ( Exp.ident
          {
            loc = Location.none;
            txt =
              mk_element_bind (if more_than_one_children then "jsxs" else "jsx");
          },
        [] )
    | Some key_prop ->
      ( Exp.ident
          {
            loc = Location.none;
            txt =
              mk_element_bind
                (if more_than_one_children then "jsxsKeyed" else "jsxKeyed");
          },
        [key_prop; (nolabel, unit_expr ~loc:Location.none)] )
  in
  let args = [(nolabel, element_tag); (nolabel, props_record)] @ key_and_unit in
  Exp.apply ~loc ~attrs ~transformed_jsx:true jsx_expr args

(* In most situations, the component name is the make function from a module. 
    However, if the name contains a lowercase letter, it means it probably an external component.
    In this case, we use the name as is.
    See tests/syntax_tests/data/ppx/react/externalWithCustomName.res
*)
let mk_uppercase_tag_name_expr tag_name =
  let tag_identifier : Longident.t =
    match tag_name.txt with
    | JsxTagInvalid _ | JsxLowerTag _ ->
      failwith "Unreachable code at mk_uppercase_tag_name_expr"
    | JsxQualifiedLowerTag {path; name} -> Longident.Ldot (path, name)
    | JsxUpperTag path -> Longident.Ldot (path, "make")
  in
  let loc = tag_name.loc in
  Exp.ident ~loc {txt = tag_identifier; loc}

let expr ~(config : Jsx_common.jsx_config) mapper expression =
  match expression with
  | {
   pexp_desc = Pexp_jsx_element jsx_element;
   pexp_loc = loc;
   pexp_attributes = attrs;
  } -> (
    match jsx_element with
    | Jsx_fragment {jsx_fragment_children = children} ->
      let fragment =
        Exp.ident ~loc {loc; txt = module_access_name config "jsxFragment"}
      in
      mk_react_jsx config mapper loc attrs FragmentComponent fragment []
        children
    | Jsx_unary_element
        {jsx_unary_element_tag_name = tag_name; jsx_unary_element_props = props}
      -> (
      let name = Ast_helper.Jsx.string_of_jsx_tag_name tag_name.txt in
      let tag_loc = tag_name.loc in
      match tag_name.txt with
      | JsxLowerTag _ ->
        (* For example 'input' *)
        let component_name_expr = constant_string ~loc:tag_loc name in
        mk_react_jsx config mapper loc attrs LowercasedComponent
          component_name_expr props []
      | JsxUpperTag _ | JsxQualifiedLowerTag _ ->
        (* MyModule.make *)
        let make_id = mk_uppercase_tag_name_expr tag_name in
        mk_react_jsx config mapper loc attrs UppercasedComponent make_id props
          []
      | JsxTagInvalid name ->
        Jsx_common.raise_error ~loc
          "JSX: element name is neither upper- or lowercase, got \"%s\"" name)
    | Jsx_container_element
        {
          jsx_container_element_tag_name_start = tag_name;
          jsx_container_element_props = props;
          jsx_container_element_children = children;
        } -> (
      let name, tag_loc =
        (Ast_helper.Jsx.string_of_jsx_tag_name tag_name.txt, tag_name.loc)
      in
      (* For example: <div> <h1></h1> <br /> </div>
         This has an impact if we want to use ReactDOM.jsx or ReactDOM.jsxs
           *)
      match tag_name.txt with
      | JsxLowerTag _ ->
        let component_name_expr = constant_string ~loc:tag_loc name in
        mk_react_jsx config mapper loc attrs LowercasedComponent
          component_name_expr props children
      | JsxQualifiedLowerTag _ | JsxUpperTag _ ->
        (* MyModule.make *)
        let make_id = mk_uppercase_tag_name_expr tag_name in
        mk_react_jsx config mapper loc attrs UppercasedComponent make_id props
          children
      | JsxTagInvalid name ->
        Jsx_common.raise_error ~loc
          "JSX: element name is neither upper- or lowercase, got \"%s\"" name))
  | e -> default_mapper.expr mapper e

let module_binding ~(config : Jsx_common.jsx_config) mapper module_binding =
  config.nested_modules <- module_binding.pmb_name.txt :: config.nested_modules;
  let mapped = default_mapper.module_binding mapper module_binding in
  let () =
    match config.nested_modules with
    | _ :: rest -> config.nested_modules <- rest
    | [] -> ()
  in
  mapped

(* TODO: some line number might still be wrong *)
let jsx_mapper ~config =
  let expr = expr ~config in
  let module_binding = module_binding ~config in
  let transform_structure_item = transform_structure_item ~config in
  let transform_signature_item = transform_signature_item ~config in
  (expr, module_binding, transform_signature_item, transform_structure_item)