From 702a5cd3c3fcc852b0d007d9f5782a69f844b4f9 Mon Sep 17 00:00:00 2001
From: David Sancho <dsnxmoreno@gmail.com>
Date: Fri, 19 Jul 2024 17:39:54 +0200
Subject: [PATCH] Transform Pexp_function with browser_only (#146)

---
 packages/browser-ppx/ppx.ml                | 11 ++++++
 packages/browser-ppx/tests/pexp_function.t | 46 ++++++++++++++++++++++
 2 files changed, 57 insertions(+)
 create mode 100644 packages/browser-ppx/tests/pexp_function.t

diff --git a/packages/browser-ppx/ppx.ml b/packages/browser-ppx/ppx.ml
index 6b8806e9a..ab78a58f0 100644
--- a/packages/browser-ppx/ppx.ml
+++ b/packages/browser-ppx/ppx.ml
@@ -247,6 +247,17 @@ module Browser_only = struct
           in
           let item = { fn with pexp_attributes = expr.pexp_attributes } in
           make_vb_with_browser_only ~loc pattern item
+      | Pexp_function _cases ->
+          (* Because pexp_function doesn't have a pattern, neither a label, we construct an empty pattern and use it to generate the vb *)
+          let original_function_name = get_function_name pattern.ppat_desc in
+          let fn =
+            Builder.pexp_fun ~loc Nolabel None
+              [%pat? _]
+              (last_expr_to_raise_impossible ~loc original_function_name
+                 expression)
+          in
+          let item = { fn with pexp_attributes = expression.pexp_attributes } in
+          make_vb_with_browser_only ~loc pattern item
       | Pexp_ident { txt = _longident; loc } ->
           let item = [%expr Obj.magic ()] in
           make_vb_with_browser_only ~loc pattern item
diff --git a/packages/browser-ppx/tests/pexp_function.t b/packages/browser-ppx/tests/pexp_function.t
new file mode 100644
index 000000000..cab908271
--- /dev/null
+++ b/packages/browser-ppx/tests/pexp_function.t
@@ -0,0 +1,46 @@
+  $ cat > input.re << EOF
+  > let%browser_only foo = fun
+  >     | x when x < 0. => None
+  >     | x => Some("bar");
+  > 
+  > let make = () => {
+  >   let%browser_only foo = fun
+  >     | x when x < 0. => None
+  >     | x => Some("bar");
+  >   ();
+  > };
+  > EOF
+
+  $ refmt --parse re --print ml input.re > input.ml
+
+With -js flag everything keeps as it is and browser_only extension disappears
+
+  $ ./standalone.exe -impl input.ml -js | ocamlformat - --enable-outside-detected-project --impl
+  let foo = function x when x < 0. -> None | x -> Some "bar" [@explicit_arity]
+  
+  let make () =
+    let foo = function
+      | x when x < 0. -> None
+      | x -> Some "bar" [@explicit_arity]
+    in
+    ()
+
+Without -js flag, the compilation to native errors out indicating that a function must be used
+
+  $ ./standalone.exe -impl input.ml | ocamlformat - --enable-outside-detected-project --impl
+  let (foo
+      [@alert
+        browser_only
+          "This expression is marked to only run on the browser where JavaScript \
+           can run. You can only use it inside a let%browser_only function."]) =
+   fun [@alert "-browser_only"] _ -> Runtime.fail_impossible_action_in_ssr "foo"
+  [@@warning "-27-32"]
+  
+  let make () =
+    let foo =
+      [%ocaml.error
+        "[browser_ppx] browser_only works on function definitions. For other \
+         cases, use switch%platform or feel free to open an issue in \
+         https://github.com/ml-in-barcelona/server-reason-react."]
+    in
+    ()