Merge remote-tracking branch 'origin/main' into feat/navigation

* origin/main:
  Specify model values at React (#309)

Author: pedrobslisboa

documentation/universal-code.mld

@@ -74,7 +74,7 @@ module ServerReasonReact = {
       | Fragment(array(element));
 
     // createElement is a function that returns a React.element
-    let createElement = name => React.Element(string);
+    let createElement = name => React.Model.Element(string);
   };
 };
 ]}

packages/react/src/React.ml

@@ -402,6 +402,7 @@ type element =
 
 and lower_case_element = { key : string option; tag : string; attributes : JSX.prop list; children : element list }
 and client_props = (string * element Model.t) list
+and model_value = element Model.t
 
 exception Invalid_children of string
 

packages/react/src/React.mli

@@ -585,6 +585,7 @@ type element =
 
 and lower_case_element = { key : string option; tag : string; attributes : JSX.prop list; children : element list }
 and client_props = (string * element Model.t) list
+and model_value = element Model.t
 
 exception Invalid_children of string
 

packages/reactDom/src/ReactServerDOM.ml

@@ -245,10 +245,8 @@ module Model = struct
       context.push (to_chunk (Debug_ref (`String debug_info_ref)) current_index) |> ignore
     else ()
 
-  let rec element_to_payload ~context ?(debug = false) ~to_chunk ~env element =
-    let is_root = ref true in
-
-    let rec turn_element_into_payload ~context element =
+  let rec element_to_payload ?(debug = false) ~context ~is_root ~to_chunk ~env element =
+    let rec turn_element_into_payload ~context ~is_root element =
       match (element : React.element) with
       | Empty -> `Null
       | DangerouslyInnerHtml _ ->
@@ -272,35 +270,28 @@ module Model = struct
               attributes
           in
           let props = props_to_json attributes in
-          node ~key ~tag ~props (List.map (turn_element_into_payload ~context) children)
-      | Fragment children ->
-          if is_root.contents then is_root := false;
-          turn_element_into_payload ~context children
-      | List children ->
-          if is_root.contents then is_root := false;
-          `List (List.map (turn_element_into_payload ~context) children)
-      | Array children ->
-          if is_root.contents then is_root := false;
-          `List (Array.map (turn_element_into_payload ~context) children |> Array.to_list)
+          node ~key ~tag ~props (List.map (turn_element_into_payload ~context ~is_root) children)
+      | Fragment children -> turn_element_into_payload ~context ~is_root:false children
+      | List children -> `List (List.map (turn_element_into_payload ~context ~is_root:false) children)
+      | Array children -> `List (Array.map (turn_element_into_payload ~context ~is_root:false) children |> Array.to_list)
       | Upper_case_component (name, component) -> (
           (* TODO: Get the stack info from component *)
           match component () with
           | element ->
               (* TODO: Can we remove the is_root difference. It currently align with react.js behavior, but it's not clear what is the purpose of it *)
-              if is_root.contents then (
-                is_root := false;
+              if is_root then (
                 (*
                   If it's the root element, React returns the element payload instead of a reference value. 
                   Root is a special case: https://github.com/facebook/react/blob/f3a803617ec4ba9d14bf5205ffece28ed1496a1d/packages/react-server/src/ReactFlightServer.js#L756-L766 
                 *)
                 if debug then push_debug_info ~context ~to_chunk ~env ~index:0 ~ownerName:name else ();
-                turn_element_into_payload ~context element)
+                turn_element_into_payload ~context ~is_root:false element)
               else
                 (* If it's not the root React push the element to the stream and return the reference value *)
                 let element_index =
                   Stream.push ~context (fun index ->
                       if debug then push_debug_info ~context ~to_chunk ~env ~index ~ownerName:name else ();
-                      let payload = turn_element_into_payload ~context element in
+                      let payload = turn_element_into_payload ~context ~is_root element in
                       to_chunk (Value payload) index)
                 in
                 `String (ref_value element_index)
@@ -318,12 +309,12 @@ module Model = struct
               let error = make_error ~message ~stack ~digest:"" in
               let index = Stream.push ~context (to_chunk (Error (env, error))) in
               `String (lazy_value index)
-          | Return element -> turn_element_into_payload ~context element
+          | Return element -> turn_element_into_payload ~context ~is_root:false element
           | Sleep ->
               let promise =
                 try%lwt
                   let%lwt element = promise in
-                  Lwt.return (to_chunk (Value (turn_element_into_payload ~context element)))
+                  Lwt.return (to_chunk (Value (turn_element_into_payload ~context ~is_root element)))
                 with exn ->
                   let message = Printexc.to_string exn in
                   let stack = create_stack_trace () in
@@ -335,29 +326,26 @@ module Model = struct
       | Suspense { key; children; fallback } ->
           (* TODO: Need to check is_root? *)
           (* TODO: Maybe we need to push suspense index and suspense node separately *)
-          let fallback = turn_element_into_payload ~context fallback in
-          suspense_node ~key ~fallback [ turn_element_into_payload ~context children ]
+          let fallback = turn_element_into_payload ~context ~is_root fallback in
+          suspense_node ~key ~fallback [ turn_element_into_payload ~context ~is_root children ]
       | Client_component { import_module; import_name; props; client = _ } ->
           let ref = component_ref ~module_:import_module ~name:import_name in
           let index = Stream.push ~context (to_chunk (Component_ref ref)) in
-          let client_props = client_values_to_json ~context ~to_chunk ~env props in
+          let client_props = models_to_payload ~context ~to_chunk ~env props in
           node ~tag:(ref_value index) ~props:client_props []
       (* TODO: Do we need to do anything with Provider and Consumer? *)
-      | Provider children -> turn_element_into_payload ~context children
-      | Consumer children -> turn_element_into_payload ~context children
+      | Provider children -> turn_element_into_payload ~context ~is_root children
+      | Consumer children -> turn_element_into_payload ~context ~is_root children
     in
-    turn_element_into_payload ~context element
+    turn_element_into_payload ~context ~is_root element
 
-  and client_value_to_json ~context ?debug ~to_chunk ~env value =
-    match (value : React.element React.Model.t) with
+  and model_to_payload ~context ?debug ~is_root ~to_chunk ~env value =
+    match (value : React.model_value) with
     | Json json -> json
     | Error error ->
         let index = Stream.push ~context (to_chunk (Error (env, error))) in
         `String (error_value index)
-    | Element element ->
-        let payload = element_to_payload ~context ?debug ~to_chunk ~env element in
-        let index = Stream.push ~context (to_chunk (Value payload)) in
-        `String (ref_value index)
+    | Element element -> element_to_payload ~context ?debug ~is_root ~to_chunk ~env element
     | Promise (promise, value_to_json) -> (
         match Lwt.state promise with
         | Return value ->
@@ -381,27 +369,27 @@ module Model = struct
             (* TODO: https://github.com/ml-in-barcelona/server-reason-react/issues/251 *)
             raise exn)
     | List list ->
-        let list = List.map (fun element -> client_value_to_json ?debug ~context ~to_chunk ~env element) list in
+        let list = List.map (fun element -> model_to_payload ~context ~is_root ~to_chunk ~env element) list in
         `List list
     | Assoc assoc ->
         let assoc =
-          List.map (fun (name, value) -> (name, client_value_to_json ?debug ~context ~to_chunk ~env value)) assoc
+          List.map (fun (name, value) -> (name, model_to_payload ~context ~is_root ~to_chunk ~env value)) assoc
         in
         `Assoc assoc
     | Function action ->
         let index = Stream.push ~context (to_chunk (Value (`Assoc [ ("id", `String action.id); ("bound", `Null) ]))) in
         `String (action_value index)
 
-  and client_values_to_json ~context ~to_chunk ~env props =
-    List.map (fun (name, value) -> (name, client_value_to_json ~context ~to_chunk ~env value)) props
+  and models_to_payload ~context ~to_chunk ~env props =
+    List.map (fun (name, value) -> (name, model_to_payload ~context ~is_root:false ~to_chunk ~env value)) props
 
-  let render ?(env = `Dev) ?(debug = false) ?subscribe element =
+  let render ?(env = `Dev) ?(debug = false) ?subscribe model =
     let stream, context = Stream.make () in
-    let to_root_chunk element id =
-      let payload = client_value_to_json ~debug ~context ~to_chunk ~env element in
+    let to_root_chunk model id =
+      let payload = model_to_payload ~debug ~is_root:true ~context ~to_chunk ~env model in
       to_chunk (Value payload) id
     in
-    Stream.push ~context (to_root_chunk element) |> ignore;
+    Stream.push ~context (to_root_chunk model) |> ignore;
     if context.pending = 0 then context.close ();
     match subscribe with None -> Lwt.return () | Some subscribe -> Lwt_stream.iter_s subscribe stream
 
@@ -417,7 +405,7 @@ module Model = struct
     in
     let stream, context = Stream.make () in
     let to_root_chunk value id =
-      let payload = client_value_to_json ~debug ~context ~to_chunk ~env value in
+      let payload = model_to_payload ~debug ~is_root:true ~context ~to_chunk ~env value in
       to_chunk (Value payload) id
     in
     Stream.push ~context (to_root_chunk response) |> ignore;
@@ -571,7 +559,7 @@ let rec render_element_to_html ~(fiber : Fiber.t) (element : React.element) : (H
   | Client_component { import_module; import_name; props; client } ->
       let context = fiber.context in
       let env = fiber.env in
-      let props = Model.client_values_to_json ~context ~to_chunk:model_to_chunk ~env props in
+      let props = Model.models_to_payload ~context ~to_chunk:model_to_chunk ~env props in
       let%lwt html = client_to_html ~fiber client in
       let ref : json = Model.component_ref ~module_:import_module ~name:import_name in
       let index = Stream.push ~context (model_to_chunk (Component_ref ref)) in
@@ -936,8 +924,8 @@ let decodeFormDataReply formData =
   (args, aux (Js.FormData.make ()) formDataEntries)
 
 type server_function =
-  | FormData of (Yojson.Basic.t array -> Js.FormData.t -> React.element React.Model.t Lwt.t)
-  | Body of (Yojson.Basic.t array -> React.element React.Model.t Lwt.t)
+  | FormData of (Yojson.Basic.t array -> Js.FormData.t -> React.model_value Lwt.t)
+  | Body of (Yojson.Basic.t array -> React.model_value Lwt.t)
 
 module type FunctionReferences = sig
   type t

packages/reactDom/src/ReactServerDOM.mli

@@ -9,18 +9,14 @@ val render_html :
   (string * ((string -> unit Lwt.t) -> unit Lwt.t)) Lwt.t
 
 val render_model :
-  ?env:[ `Dev | `Prod ] -> ?debug:bool -> ?subscribe:(string -> unit Lwt.t) -> React.element React.Model.t -> unit Lwt.t
+  ?env:[ `Dev | `Prod ] -> ?debug:bool -> ?subscribe:(string -> unit Lwt.t) -> React.model_value -> unit Lwt.t
 
 val create_action_response :
-  ?env:[ `Dev | `Prod ] ->
-  ?debug:bool ->
-  ?subscribe:(string -> unit Lwt.t) ->
-  React.element React.Model.t Lwt.t ->
-  unit Lwt.t
+  ?env:[ `Dev | `Prod ] -> ?debug:bool -> ?subscribe:(string -> unit Lwt.t) -> React.model_value Lwt.t -> unit Lwt.t
 
 type server_function =
-  | FormData of (Yojson.Basic.t array -> Js.FormData.t -> React.element React.Model.t Lwt.t)
-  | Body of (Yojson.Basic.t array -> React.element React.Model.t Lwt.t)
+  | FormData of (Yojson.Basic.t array -> Js.FormData.t -> React.model_value Lwt.t)
+  | Body of (Yojson.Basic.t array -> React.model_value Lwt.t)
 
 val decodeReply : string -> Yojson.Basic.t array
 val decodeFormDataReply : Js.FormData.t -> Yojson.Basic.t array * Js.FormData.t

packages/reactDom/test/test_RSC_html.ml

@@ -341,16 +341,43 @@ let client_with_element_props () =
   in
   assert_html (app ())
     ~shell:
-      "Client with elment prop<script data-payload='0:[\"$\",\"$2\",null,{\"element\":\"$1\"},null,[],{}]\n\
+      "Client with elment prop<script \
+       data-payload='0:[\"$\",\"$1\",null,{\"element\":[\"$\",\"span\",null,{\"children\":\"server-component-as-props-to-client-component\"},null,[],{}]},null,[],{}]\n\
        '>window.srr_stream.push()</script>"
     [
-      "<script \
-       data-payload='1:[\"$\",\"span\",null,{\"children\":\"server-component-as-props-to-client-component\"},null,[],{}]\n\
-       '>window.srr_stream.push()</script>";
-      "<script data-payload='2:I[\"./client-with-props.js\",[],\"ClientWithProps\"]\n\
+      "<script data-payload='1:I[\"./client-with-props.js\",[],\"ClientWithProps\"]\n\
        '>window.srr_stream.push()</script>";
     ]
 
+let client_component_with_async_component () =
+  let children =
+    React.Async_component
+      ( __FUNCTION__,
+        fun () ->
+          let%lwt () = sleep ~ms:10 in
+          Lwt.return (React.string "Async Component") )
+  in
+  let app ~children =
+    React.Upper_case_component
+      ( "app",
+        fun () ->
+          React.Client_component
+            {
+              import_module = "./client.js";
+              import_name = "Client";
+              props = [ ("children", React.Model.Element children) ];
+              client = children;
+            } )
+  in
+  assert_html (app ~children)
+    ~shell:
+      "Async Component<script data-payload='0:[\"$\",\"$2\",null,{\"children\":\"$L1\"},null,[],{}]\n\
+       '>window.srr_stream.push()</script>"
+    [
+      "<script data-payload='1:\"Async Component\"\n'>window.srr_stream.push()</script>";
+      "<script data-payload='2:I[\"./client.js\",[],\"Client\"]\n'>window.srr_stream.push()</script>";
+    ]
+
 let suspense_with_error () =
   let app () =
     React.Suspense.make ~fallback:(React.string "Loading...")
@@ -630,88 +657,6 @@ let nested_context () =
       "<script data-payload='a:I[\"./provider.js\",[],\"Provider\"]\n'>window.srr_stream.push()</script>";
     ]
 
-let client_component_with_async_component () =
-  let children =
-    React.Async_component
-      ( __FUNCTION__,
-        fun () ->
-          let%lwt () = sleep ~ms:10 in
-          Lwt.return (React.string "Async Component") )
-  in
-  let app ~children =
-    React.Client_component
-      {
-        import_module = "./client.js";
-        import_name = "Client";
-        props = [ ("children", React.Model.Element children) ];
-        client = children;
-      }
-  in
-  assert_html (app ~children)
-    ~shell:
-      "Async Component<script data-payload='0:[\"$\",\"$1\",null,{\"children\":\"Async Component\"},null,[],{}]\n\
-       '>window.srr_stream.push()</script>"
-    [ "<script data-payload='1:I[\"./client.js\",[],\"Client\"]\n'>window.srr_stream.push()</script>" ]
-
-(* This test ensures that we don't push multiple scripts for the Suspense component *)
-let client_component_with_nested_suspense_client_component () =
-  let async_suspense ~children =
-    React.Suspense.make ~fallback:(React.string "Loading...")
-      ~children:
-        (React.Async_component
-           ( "async_suspense",
-             fun () ->
-               let%lwt () = sleep ~ms:10 in
-               Lwt.return children ))
-      ()
-  in
-  let client_component ~children =
-    React.Client_component
-      {
-        import_module = "./client.js";
-        import_name = "Client";
-        props = [ ("children", React.Model.Element children) ];
-        client = children;
-      }
-  in
-  assert_html
-    (client_component
-       ~children:
-         (React.array
-            [|
-              React.string "Root";
-              async_suspense
-                ~children:
-                  (React.array
-                     [|
-                       React.string "Level 2";
-                       client_component
-                         ~children:
-                           (React.array
-                              [|
-                                React.string "Level 3";
-                                client_component ~children:(async_suspense ~children:(React.string "Level 4"));
-                              |]);
-                     |]);
-            |]))
-    ~shell:
-      "Root<!--$?--><template id=\"B:1\"></template>Loading...<!--/$--><script \
-       data-payload='0:[\"$\",\"$3\",null,{\"children\":[\"Root\",[\"$\",\"$Sreact.suspense\",null,{\"fallback\":\"Loading...\",\"children\":\"$L2\"},null,[],{}]]},null,[],{}]\n\
-       '>window.srr_stream.push()</script>"
-    [
-      "<script data-payload='3:I[\"./client.js\",[],\"Client\"]\n'>window.srr_stream.push()</script>";
-      "<div hidden=\"true\" id=\"S:1\">Level 2<!-- -->Level 3<!--$?--><template \
-       id=\"B:4\"></template>Loading...<!--/$--></div>\n\
-       <script>$RC('B:1', 'S:1')</script>";
-      "<script data-payload='8:I[\"./client.js\",[],\"Client\"]\n'>window.srr_stream.push()</script>";
-      "<script data-payload='9:I[\"./client.js\",[],\"Client\"]\n'>window.srr_stream.push()</script>";
-      "<script data-payload='2:[\"Level 2\",[\"$\",\"$9\",null,{\"children\":[\"Level \
-       3\",[\"$\",\"$8\",null,{\"children\":[\"$\",\"$Sreact.suspense\",null,{\"fallback\":\"Loading...\",\"children\":\"$L7\"},null,[],{}]},null,[],{}]]},null,[],{}]]\n\
-       '>window.srr_stream.push()</script>";
-      "<div hidden=\"true\" id=\"S:4\">Level 4</div>\n<script>$RC('B:4', 'S:4')</script>";
-      "<script data-payload='7:\"Level 4\"\n'>window.srr_stream.push()</script>";
-    ]
-
 let tests =
   [
     (* test "debug_adds_debug_info" debug_adds_debug_info; *)
@@ -734,8 +679,6 @@ let tests =
     test "error_in_toplevel_in_async" error_in_toplevel_in_async;
     test "suspense_in_a_list_with_error" suspense_in_a_list_with_error;
     test "server_function_as_action" server_function_as_action;
-    test "client_component_with_async_component" client_component_with_async_component;
-    test "client_component_with_nested_suspense_client_component" client_component_with_nested_suspense_client_component;
     (* test "nested_context" nested_context; *)
     (* test "client_component_with_suspense_prop" client_component_with_suspense_prop; *)
     (* test "page_with_resources" page_with_resources;