Allow labelled arguments after () when defining components using %component syntax

jsx/brisk_jsx.ml

@@ -79,36 +79,41 @@ module JSX_ppx = struct
 end
 
 module Declaration_ppx = struct
-  let func_pattern = Ppxlib.Ast_pattern.(pexp_fun __ __ __ __)
-
-  let match_ pattern ?on_error loc ast_node ~with_ =
-    Ppxlib.Ast_pattern.parse pattern ?on_error loc ast_node with_
-
   let attribute_name = function
     | `Component ->
         "component"
     | `Native ->
         "nativeComponent"
 
   let transform_component_expr ~useDynamicKey ~attribute ~component_name expr =
-    let rec map_component_expression ({P.pexp_loc= loc} as expr) =
-      match_ func_pattern loc expr
-        ~with_:(fun lbl opt_arg pat child_expression ->
+    let map_component_expression expr =
+      let rec loop ~seenUnit ({P.pexp_loc=loc; pexp_desc} as expr) = 
+        match pexp_desc with
+        | P.Pexp_fun (lbl, opt_arg, pat, child_expression) ->
           let make_fun_with_expr ~expr =
             Ast_builder.pexp_fun ~loc lbl opt_arg pat expr
           in
           let loc = pat.Ppxlib.ppat_loc in
-          match (lbl, pat) with
+          ( match (lbl, pat) with
+          | (Ppxlib.Optional _), _ when seenUnit ->
+              Location.raise_errorf ~loc
+                "Optional arguments not allowed after ()"
           | (Ppxlib.Labelled _ | Optional _), _ ->
               make_fun_with_expr
-                ~expr:(map_component_expression child_expression)
+                ~expr:(loop ~seenUnit child_expression)
           | Ppxlib.Nolabel, [%pat? ()] ->
-              let loc = child_expression.pexp_loc in
               make_fun_with_expr
-                ~expr:[%expr [%e component_ident ~loc] ~key [%e child_expression]]
+                ~expr:(loop ~seenUnit:true child_expression)
           | _ ->
+            if seenUnit then
+              let loc = child_expression.pexp_loc in
+              [%expr [%e component_ident ~loc] ~key [%e make_fun_with_expr ~expr:child_expression]]
+            else
               Location.raise_errorf ~loc
                 "A labelled argument or () was expected")
+        | _ -> [%expr [%e component_ident ~loc] ~key [%e expr]]
+      in
+      loop ~seenUnit:false expr
     in
     let open P in
     let loc = expr.P.pexp_loc in

test/Components.re

@@ -235,6 +235,35 @@ module EmptyComponentWithOnMountEffect = {
 };
 
 module ShouldAllowComponentProp = {
-  let%component make = (~component, (), hooks) =>
-    (<Div> component </Div>, hooks);
-}
+  let%component make = (~component, (), hooks) => (
+    <Div> component </Div>,
+    hooks,
+  );
+};
+
+module PartiallyAppliedComponent: {
+  type t;
+  type dispatcher = int => unit;
+  let make: (~key: int=?, ~title: string, unit) => t;
+  let render: (dispatcher, t) => element(node);
+} = {
+  type dispatcher = int => unit;
+  type t = (~dispatch: dispatcher) => element(node);
+
+  let%component make = (~title, (), ~dispatch as _: dispatcher, hooks) => (
+    <Text title />,
+    hooks,
+  );
+
+  let render = (dispatch, component) => component(~dispatch);
+};
+
+module PartiallyAppliedComponentConsumer: {
+  let make: (~key: int=?, unit) => element(node);
+} = {
+  let%component make = ((), hooks) => {
+    let dispatch = _ => ();
+    let comp = <PartiallyAppliedComponent title="" />;
+    (PartiallyAppliedComponent.render(dispatch, comp), hooks);
+  };
+};