Remove raise annotations and fix locations on errors

ppx/reason_react_ppx.ml

@@ -47,8 +47,8 @@ let labelled str = Labelled str
 let optional str = Optional str
 
 module Binding = struct
-  (* Binding is the interface that the ppx uses to interact with the bindings.
-     Here we define the same APIs as the bindings but it generates Parsetree *)
+  (* Binding is the interface that the ppx relies on to interact with the react bindings.
+     Here we define the same APIs as the bindings but it generates Parsetree nodes *)
   module ReactDOM = struct
     let domProps ~applyLoc ~loc props =
       Builder.pexp_apply ~loc:applyLoc
@@ -58,9 +58,6 @@ module Binding = struct
   end
 
   module React = struct
-    let null ~loc =
-      Builder.pexp_ident ~loc { loc; txt = Ldot (Lident "React", "null") }
-
     let array ~loc children =
       Builder.pexp_apply ~loc
         (Builder.pexp_ident ~loc
@@ -98,18 +95,22 @@ let rec find_opt p = function
   | [] -> None
   | x :: l -> if p x then Some x else find_opt p l
 
-let getLabel str =
+let getLabelOrEmpty str =
   match str with Optional str | Labelled str -> str | Nolabel -> ""
 
+let getLabel str =
+  match str with Optional str | Labelled str -> Some str | Nolabel -> None
+
 let optionIdent = Lident "option"
 
 let constantString ~loc str =
   Builder.pexp_constant ~loc (Pconst_string (str, Location.none, None))
 
 let safeTypeFromValue valueStr =
-  let valueStr = getLabel valueStr in
-  match String.sub valueStr 0 1 with "_" -> "T" ^ valueStr | _ -> valueStr
-[@@raises Invalid_argument]
+  match getLabel valueStr with
+  | Some valueStr when String.sub valueStr 0 1 = "_" -> ("T" ^ valueStr)
+  | Some valueStr -> valueStr
+  | None -> ""
 
 let keyType loc = Builder.ptyp_constr ~loc { loc; txt = Lident "string" } []
 
@@ -224,14 +225,12 @@ let otherAttrsPure { attr_name = loc; _ } = loc.txt <> "react.component"
 let hasAttrOnBinding { pvb_attributes; _ } =
   find_opt hasAttr pvb_attributes <> None
 
-(* Finds the name of the variable the binding is assigned to, otherwise raises
-   Invalid_argument *)
+(* Finds the name of the variable the binding is assigned to, otherwise raises an error *)
 let getFnName binding =
   match binding with
   | { pvb_pat = { ppat_desc = Ppat_var { txt; _ }; _ }; _ } -> txt
-  | _ ->
-      raise (Invalid_argument "react.component calls cannot be destructured.")
-[@@raises Invalid_argument]
+  | { pvb_loc; _} ->
+      Location.raise_errorf ~loc:pvb_loc "[@react.component] cannot be used with a destructured binding. Please use it on a `let make = ...` binding instead."
 
 let makeNewBinding binding expression newName =
   match binding with
@@ -243,22 +242,17 @@ let makeNewBinding binding expression newName =
         pvb_expr = expression;
         pvb_attributes = [ merlinFocus ];
       }
-  | _ ->
-      raise (Invalid_argument "react.component calls cannot be destructured.")
-[@@raises Invalid_argument]
+  | { pvb_loc; _ } ->
+      Location.raise_errorf ~loc:pvb_loc "[@react.component] cannot be used with a destructured binding. Please use it on a `let make = ...` binding instead."
 
-(* Lookup the value of `props` otherwise raise Invalid_argument error *)
-let getPropsNameValue _acc (loc, exp) =
-  match (loc, exp) with
+(* Lookup the value of `props` otherwise raise errorf *)
+let getPropsNameValue _acc (loc, expr) =
+  match (loc, expr) with
   | ( { txt = Lident "props"; _ },
       { pexp_desc = Pexp_ident { txt = Lident str; _ }; _ } ) ->
       { propsName = str }
-  | { txt; _ }, _ ->
-      raise
-        (Invalid_argument
-           ("react.component only accepts props as an option, given: "
-          ^ Longident.last_exn txt))
-[@@raises Invalid_argument]
+  | { txt; loc }, _ ->
+      Location.raise_errorf ~loc "[@react.component] only accepts 'props' as a field, given: %s" (Longident.last_exn txt)
 
 (* Lookup the `props` record or string as part of [@react.component] and store
    the name for use when rewriting *)
@@ -284,12 +278,10 @@ let getPropsAttr payload =
          }
         :: _rest)) ->
       { propsName = "props" }
-  | Some (PStr ({ pstr_desc = Pstr_eval (_, _); _ } :: _rest)) ->
-      raise
-        (Invalid_argument
-           "react.component accepts a record config with props as an options.")
+  | Some (PStr ({ pstr_desc = Pstr_eval (_, _); pstr_loc; _ } :: _rest)) ->
+      Location.raise_errorf ~loc:pstr_loc
+        "[@react.component] accepts a record config with 'props' as a field."
   | _ -> defaultProps
-[@@raises Invalid_argument]
 
 (* Plucks the label, loc, and type_ from an AST node *)
 let pluckLabelDefaultLocType (label, default, _, _, loc, type_) =
@@ -370,7 +362,6 @@ let rec recursivelyMakeNamedArgsForExternal ~types_come_from_signature list args
            | _label, Some type_, _ -> type_)
            args)
   | [] -> args
-[@@raises Invalid_argument]
 
 (* Build an AST node for the [@bs.obj] representing props for a component *)
 let makePropsValue fnName ~types_come_from_signature loc
@@ -400,7 +391,6 @@ let makePropsValue fnName ~types_come_from_signature loc
       ];
     pval_loc = loc;
   }
-[@@raises Invalid_argument]
 
 (* Build an AST node representing an `external` with the definition of the
    [@bs.obj] *)
@@ -413,7 +403,6 @@ let makePropsExternal fnName loc ~component_is_external
         (makePropsValue ~types_come_from_signature:component_is_external fnName
            loc namedArgListWithKeyAndRef propsType);
   }
-[@@raises Invalid_argument]
 
 (* Build an AST node for the signature of the `external` definition *)
 let makePropsExternalSig fnName loc namedArgListWithKeyAndRef propsType =
@@ -424,7 +413,6 @@ let makePropsExternalSig fnName loc namedArgListWithKeyAndRef propsType =
         (makePropsValue ~types_come_from_signature:true fnName loc
            namedArgListWithKeyAndRef propsType);
   }
-[@@raises Invalid_argument]
 
 (* Build an AST node for the props name when converted to an object inside the
    function signature *)
@@ -518,7 +506,6 @@ let makeExternalDecl fnName loc namedArgListWithKeyAndRef namedTypeList =
   makePropsExternal ~component_is_external:false fnName loc
     (List.map pluckLabelDefaultLocType namedArgListWithKeyAndRef)
     (makePropsType ~loc namedTypeList)
-[@@raises Invalid_argument]
 
 (* TODO: some line number might still be wrong *)
 let jsxMapper =
@@ -529,7 +516,7 @@ let jsxMapper =
     let argsForMake = argsWithLabels in
     let keyProps, otherProps =
       List.partition
-        (fun (arg_label, _) -> "key" = getLabel arg_label)
+        (fun (arg_label, _) -> "key" = getLabelOrEmpty arg_label)
         argsForMake
     in
     let jsxExpr, key, childrenProp =
@@ -543,10 +530,12 @@ let jsxMapper =
              (label, mapper#expression ctxt expression))
     in
     let isCap str =
-      let first = String.sub str 0 1 [@@raises Invalid_argument] in
-      let capped = String.uppercase_ascii first in
-      first = capped
-        [@@raises Invalid_argument]
+      match String.length str with
+      | 0 -> false
+      | _ ->
+          let first = String.sub str 0 1 in
+          let capped = String.uppercase_ascii first in
+          first = capped
     in
     let ident =
       match modulePath with
@@ -608,7 +597,7 @@ let jsxMapper =
     let componentNameExpr = constantString ~loc:callerLoc id in
     let keyProps, nonChildrenProps =
       List.partition
-        (fun (arg_label, _) -> "key" = getLabel arg_label)
+        (fun (arg_label, _) -> "key" = getLabelOrEmpty arg_label)
         nonChildrenProps
     in
 
@@ -657,17 +646,9 @@ let jsxMapper =
   let rec recursivelyTransformNamedArgsForMake ~ctxt mapper expr list =
     let expr = mapper#expression ctxt expr in
     match expr.pexp_desc with
-    (* TODO: make this show up with a loc. *)
     | Pexp_fun (Labelled "key", _, _, _) | Pexp_fun (Optional "key", _, _, _) ->
-        raise
-          (Invalid_argument
-             "Key cannot be accessed inside of a component. Don't worry - you \
-              can always key a component from its parent!")
-    | Pexp_fun (Labelled "ref", _, _, _) | Pexp_fun (Optional "ref", _, _, _) ->
-        raise
-          (Invalid_argument
-             "Ref cannot be passed as a normal prop. Please use `forwardRef` \
-              API instead.")
+        Location.raise_errorf ~loc:expr.pexp_loc
+          ("~key cannot be accessed from the component props. Please set the key where the component is being used.")
     | Pexp_fun
         ( ((Optional label | Labelled label) as arg),
           default,
@@ -714,7 +695,6 @@ let jsxMapper =
           "reason-react-ppx: react.component refs only support plain arguments \
            and type annotations."
     | _ -> (list, None)
-      [@@raises Invalid_argument]
   in
 
   let argToType types (name, default, _noLabelName, _alias, loc, type_) =
@@ -736,7 +716,7 @@ let jsxMapper =
           } )
         :: types
     | Some type_, name, Some _default ->
-        ( getLabel name,
+        ( getLabelOrEmpty name,
           [],
           {
             ptyp_desc = Ptyp_constr ({ loc; txt = optionIdent }, [ type_ ]);
@@ -745,7 +725,7 @@ let jsxMapper =
             ptyp_attributes = [];
           } )
         :: types
-    | Some type_, name, _ -> (getLabel name, [], type_) :: types
+    | Some type_, name, _ -> (getLabelOrEmpty name, [], type_) :: types
     | None, Optional label, _ ->
         ( label,
           [],
@@ -777,7 +757,6 @@ let jsxMapper =
           } )
         :: types
     | _ -> types
-      [@@raises Invalid_argument]
   in
 
   let argToConcreteType types (name, loc, type_) =
@@ -1110,7 +1089,7 @@ let jsxMapper =
             in
             let pluckArg (label, _, _, alias, loc, _) =
               ( label,
-                match getLabel label with
+                match getLabelOrEmpty label with
                 | "" -> Builder.pexp_ident ~loc { txt = Lident alias; loc }
                 | labelString ->
                     Builder.pexp_apply ~loc

ppx/test/component-without-make.t/input.re

@@ -0,0 +1,26 @@
+module X_as_main_function = {
+  [@react.component]
+  let x = () => <div />;
+};
+
+module Create_element_as_main_function = {
+  [@react.component]
+  let createElement = (~lola) => <div> {React.string(lola)} </div>;
+};
+
+/* This isn't valid running code, since Foo gets transformed into Foo.make, not createElement. */
+module Invalid_case = {
+  [@react.component]
+  let make = (~lola) => {
+    <Create_element_as_main_function lola />;
+  };
+};
+
+/* If main function is not make, neither createElement, then it can be explicitly annotated */
+/* NOTE: If you use `createElement` refmt removes it */
+module Valid_case = {
+  [@react.component]
+  let make = () => {
+    <Component_with_x_as_main_function.x />;
+  };
+};

ppx/test/component-without-make.t/run.t

@@ -0,0 +1,53 @@
+Since we generate invalid syntax for the argument of the make fn `(Props : <>)`
+We need to output ML syntax here, otherwise refmt could not parse it.
+  $ ../ppx.sh --output ml input.re
+  module X_as_main_function =
+    struct
+      external xProps : ?key:string -> unit -> <  >  Js.t = ""[@@mel.obj ]
+      let x () = ReactDOM.jsx "div" (((ReactDOM.domProps)[@merlin.hide ]) ())
+      let x =
+        let Output$X_as_main_function$x (Props : <  >  Js.t) = x () in
+        Output$X_as_main_function$x
+    end
+  module Create_element_as_main_function =
+    struct
+      external createElementProps :
+        lola:'lola -> ?key:string -> unit -> < lola: 'lola   >  Js.t = ""
+      [@@mel.obj ]
+      let createElement =
+        ((fun ~lola ->
+            ReactDOM.jsx "div"
+              (((ReactDOM.domProps)[@merlin.hide ])
+                 ~children:(React.string lola) ()))
+        [@warning "-16"])
+      let createElement =
+        let Output$Create_element_as_main_function$createElement
+          (Props : < lola: 'lola   >  Js.t) =
+          createElement ~lola:(Props ## lola) in
+        Output$Create_element_as_main_function$createElement
+    end
+  module Invalid_case =
+    struct
+      external makeProps :
+        lola:'lola -> ?key:string -> unit -> < lola: 'lola   >  Js.t = ""
+      [@@mel.obj ]
+      let make =
+        ((fun ~lola ->
+            React.jsx Create_element_as_main_function.make
+              (Create_element_as_main_function.makeProps ~lola ()))
+        [@warning "-16"])
+      let make =
+        let Output$Invalid_case (Props : < lola: 'lola   >  Js.t) =
+          make ~lola:(Props ## lola) in
+        Output$Invalid_case
+    end
+  module Valid_case =
+    struct
+      external makeProps : ?key:string -> unit -> <  >  Js.t = ""[@@mel.obj ]
+      let make () =
+        React.jsx Component_with_x_as_main_function.x
+          (Component_with_x_as_main_function.xProps ())
+      let make =
+        let Output$Valid_case (Props : <  >  Js.t) = make () in
+        Output$Valid_case
+    end

ppx/test/component.t/input.re

@@ -41,6 +41,13 @@ module Forward_Ref = {
     });
 };
 
+module Ref_as_prop = {
+  [@react.component]
+  let make = (~children, ~ref) => {
+    <button ref className="FancyButton"> children </button>;
+  };
+};
+
 module Onclick_handler_button = {
   [@react.component]
   let make = (~name, ~isDisabled=?) => {

ppx/test/component.t/run.t

@@ -68,6 +68,27 @@ We need to output ML syntax here, otherwise refmt could not parse it.
              make ~buttonRef:(Props ## buttonRef) ~children:(Props ## children) in
            Output$Forward_Ref)
     end
+  module Ref_as_prop =
+    struct
+      external makeProps :
+        children:'children ->
+          ref:'ref ->
+            ?key:string -> unit -> < children: 'children  ;ref: 'ref   >  Js.t
+          = ""[@@mel.obj ]
+      let make =
+        ((fun ~children ->
+            ((fun ~ref ->
+                ReactDOM.jsx "button"
+                  (((ReactDOM.domProps)[@merlin.hide ]) ~children ~ref
+                     ~className:"FancyButton" ()))
+            [@warning "-16"]))
+        [@warning "-16"])
+      let make =
+        let Output$Ref_as_prop
+          (Props : < children: 'children  ;ref: 'ref   >  Js.t) =
+          make ~ref:(Props ## ref) ~children:(Props ## children) in
+        Output$Ref_as_prop
+    end
   module Onclick_handler_button =
     struct
       external makeProps :

ppx/test/components-destructured-error.t/component.re

@@ -0,0 +1,3 @@
+[@react.component]
+let (pageState, setPageState) = React.useState(_ => 0);
+let make = (~children, ()) => <div> children </div>;

ppx/test/components-destructured-error.t/run.t

@@ -0,0 +1,22 @@
+Test some locations in reason-react components
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.8)
+  > (using melange 0.1)
+  > EOF
+
+  $ cat >dune <<EOF
+  > (melange.emit
+  >  (alias foo)
+  >  (target foo)
+  >  (libraries reason-react)
+  >  (preprocess
+  >   (pps melange.ppx reason-react-ppx)))
+  > EOF
+
+  $ dune build
+  File "component.re", lines 1-2, characters 0-54:
+  1 | [@react.component]
+  2 | let (pageState, setPageState) = React.useState(_ => 0).
+  Error: [@react.component] cannot be used with a destructured binding. Please use it on a `let make = ...` binding instead.
+  [1]