Support async components in renderToLwtStream and failwith on renderT…

…oString* (#155)

packages/react/src/React.ml

@@ -383,6 +383,7 @@ type lower_case_element = {
 and element =
   | Lower_case_element of lower_case_element
   | Upper_case_component of (unit -> element)
+  | Async_component of (unit -> element Lwt.t)
   | List of element array
   | Text of string
   | InnerHtml of string
@@ -422,7 +423,7 @@ let attributes_to_map attributes =
       match attr with
       | Bool (key, value) -> acc |> StringMap.add key (Bool (key, value))
       | String (key, value) -> acc |> StringMap.add key (String (key, value))
-      (* The following constructors shoudn't be part of the Map: *)
+      (* The following constructors shoudn't be part of the StringMap *)
       | DangerouslyInnerHtml _ -> acc
       | Ref _ -> acc
       | Event _ -> acc
@@ -470,7 +471,8 @@ let createElement tag attributes children =
   | true -> Lower_case_element { tag; attributes; children = [] }
   | false -> create_element_inner tag attributes children
 
-(* cloneElements overrides childrens but is not always obvious what to do with
+(* cloneElements overrides childrens and props but is not clear
+   what to do with other components that are not lower_case_elements
    Provider, Consumer or Suspense. TODO: Check original (JS) implementation *)
 let cloneElement element new_attributes =
   match element with
@@ -489,6 +491,7 @@ let cloneElement element new_attributes =
   | Provider child -> Provider child
   | Consumer child -> Consumer child
   | Upper_case_component f -> Upper_case_component f
+  | Async_component f -> Async_component f
   | Suspense { fallback; children } -> Suspense { fallback; children }
 
 module Fragment = struct

packages/react/src/React.mli

@@ -561,6 +561,7 @@ type lower_case_element = {
 and element =
   | Lower_case_element of lower_case_element
   | Upper_case_component of (unit -> element)
+  | Async_component of (unit -> element Lwt.t)
   | List of element array
   | Text of string
   | InnerHtml of string

packages/reactDom/src/ReactDOM.ml

@@ -70,6 +70,7 @@ let render_to_string ~mode element =
   (* previous_was_text_node is the flag to enable rendering comments
      <!-- --> between text nodes *)
   let previous_was_text_node = ref false in
+
   let rec render_element element =
     match element with
     | Empty -> ""
@@ -78,7 +79,11 @@ let render_to_string ~mode element =
     | Fragment children -> render_element children
     | List list ->
         list |> Array.map render_element |> Array.to_list |> String.concat ""
-    | Upper_case_component f -> render_element (f ())
+    | Upper_case_component component -> render_element (component ())
+    | Async_component _component ->
+        failwith
+          "Asyncronous components can't be rendered to static markup, since \
+           rendering is syncronous. Please use `renderToLwtStream` instead."
     | Lower_case_element { tag; attributes; _ }
       when Html.is_self_closing_tag tag ->
         is_root.contents <- false;
@@ -157,23 +162,32 @@ let render_inline_rc_replacement replacements =
 let render_to_stream ~context_state element =
   let rec render_element element =
     match element with
-    | Empty -> ""
+    | Empty -> Lwt.return ""
     | Provider children -> render_element children
     | Consumer children -> render_element children
     | Fragment children -> render_element children
     | List arr ->
-        arr |> Array.to_list |> List.map render_element |> String.concat ""
+        let%lwt children_elements =
+          arr |> Array.to_list |> Lwt_list.map_p render_element
+        in
+        Lwt.return (String.concat "" children_elements)
     | Upper_case_component component -> render_element (component ())
     | Lower_case_element { tag; attributes; _ }
       when Html.is_self_closing_tag tag ->
-        Printf.sprintf "<%s%s />" tag (attributes_to_string attributes)
+        Lwt.return
+          (Printf.sprintf "<%s%s />" tag (attributes_to_string attributes))
+    | Async_component component ->
+        let%lwt element = component () in
+        render_element element
     | Lower_case_element { tag; attributes; children } ->
-        Printf.sprintf "<%s%s>%s</%s>" tag
-          (attributes_to_string attributes)
-          (children |> List.map render_element |> String.concat "")
-          tag
-    | Text text -> Html.encode text
-    | InnerHtml text -> text
+        let%lwt children_elements = children |> Lwt_list.map_p render_element in
+        Lwt.return
+          (Printf.sprintf "<%s%s>%s</%s>" tag
+             (attributes_to_string attributes)
+             (String.concat "" children_elements)
+             tag)
+    | Text text -> Lwt.return (Html.encode text)
+    | InnerHtml text -> Lwt.return text
     | Suspense { children; fallback } -> (
         match render_element children with
         | output -> output
@@ -185,30 +199,35 @@ let render_to_stream ~context_state element =
             context_state.boundary_id <- context_state.boundary_id + 1;
             (* Wait for promise to resolve *)
             Lwt.async (fun () ->
-                Lwt.map
-                  (fun _ ->
+                Lwt.bind promise (fun _ ->
                     (* Enqueue the component with resolved data *)
-                    context_state.push
-                      (render_resolved_element ~id:current_suspense_id children);
+                    let%lwt resolved =
+                      render_resolved_element ~id:current_suspense_id children
+                    in
+                    context_state.push resolved;
                     (* Enqueue the inline script that replaces fallback by resolved *)
                     context_state.push inline_complete_boundary_script;
                     context_state.push
                       (render_inline_rc_replacement
                          [ (current_boundary_id, current_suspense_id) ]);
                     context_state.waiting <- context_state.waiting - 1;
                     context_state.suspense_id <- context_state.suspense_id + 1;
-                    if context_state.waiting = 0 then context_state.close ())
-                  promise);
+                    if context_state.waiting = 0 then context_state.close ();
+                    Lwt.return_unit));
             (* Return the rendered fallback to SSR syncronous *)
             render_fallback ~boundary_id:current_boundary_id fallback
         | exception _exn ->
             (* TODO: log exn *)
             render_fallback ~boundary_id:context_state.boundary_id fallback)
   and render_resolved_element ~id element =
-    Printf.sprintf "<div hidden id='S:%i'>%s</div>" id (render_element element)
+    render_element element
+    |> Lwt.map (fun html ->
+           Printf.sprintf "<div hidden id='S:%i'>%s</div>" id html)
   and render_fallback ~boundary_id element =
-    Printf.sprintf "<!--$?--><template id='B:%i'></template>%s<!--/$-->"
-      boundary_id (render_element element)
+    render_element element
+    |> Lwt.map (fun element ->
+           Printf.sprintf "<!--$?--><template id='B:%i'></template>%s<!--/$-->"
+             boundary_id element)
   in
   render_element element
 
@@ -217,14 +236,18 @@ let renderToLwtStream element =
   let context_state =
     { stream; push; close; waiting = 0; boundary_id = 0; suspense_id = 0 }
   in
-  let shell = render_to_stream ~context_state element in
+  let%lwt shell = render_to_stream ~context_state element in
   push shell;
   if context_state.waiting = 0 then close ();
-  (* TODO: Needs to flush the remaining loading fallbacks as HTML, and will attempt to render the rest on the client. *)
-  let abort () = (* Lwt_stream.closed stream |> Lwt.ignore_result *) () in
-  (stream, abort)
+  let abort () =
+    (* TODO: Needs to flush the remaining loading fallbacks as HTML, and React.js will try to render the rest on the client. *)
+    (* Lwt_stream.closed stream |> Lwt.ignore_result *)
+    failwith "abort() isn't supported yet"
+  in
+  Lwt.return (stream, abort)
 
-let querySelector _str = None
+let querySelector _str =
+  Runtime.fail_impossible_action_in_ssr "ReactDOM.querySelector"
 
 let render _element _node =
   Runtime.fail_impossible_action_in_ssr "ReactDOM.render"
@@ -238,7 +261,7 @@ module Style = ReactDOMStyle
 
 let createDOMElementVariadic (tag : string) ~props
     (childrens : React.element array) =
-  React.createElement tag props (childrens |> Array.to_list)
+  React.createElement tag props (Array.to_list childrens)
 
 let add kind value map =
   match value with Some i -> map |> List.cons (kind i) | None -> map
@@ -251,7 +274,6 @@ let booleanish_string name v = JSX.string name (string_of_bool v)
 [@@@ocamlformat "disable"]
 (* domProps isn't used by the generated code from the ppx, and it's purpose is to
    allow usages from user's code via createElementVariadic and custom usages outside JSX. It needs to be in sync with domProps *)
-(* Props are added alphabetically instead of the order of  *)
 let domProps
   ?key
   ?ref

packages/reactDom/src/ReactDOM.mli

@@ -11,7 +11,8 @@ val renderToStaticMarkup : React.element -> string
 
 Similar to {{:https://react.dev/reference/react-dom/server/renderToStaticMarkup}} *)
 
-val renderToLwtStream : React.element -> string Lwt_stream.t * (unit -> unit)
+val renderToLwtStream :
+  React.element -> (string Lwt_stream.t * (unit -> unit)) Lwt.t
 (** renderToPipeableStream renders a React tree to a Lwt_stream.t.
 
 Similar to {{:https://react.dev/reference/react-dom/server/renderToPipeableStream}} *)

packages/reactDom/src/dune

@@ -2,4 +2,6 @@
  (name reactDOM)
  (wrapped false)
  (public_name server-reason-react.reactDom)
- (libraries react js html lwt runtime))
+ (libraries react js html lwt runtime)
+ (preprocess
+  (pps lwt_ppx)))

packages/reactDom/test/dune

@@ -10,4 +10,4 @@
   alcotest
   alcotest-lwt)
  (preprocess
-  (pps server-reason-react.ppx)))
+  (pps server-reason-react.ppx lwt_ppx)))

packages/reactDom/test/test_renderToLwtStream.ml

@@ -4,7 +4,7 @@ let assert_string left right =
 let assert_list ty left right =
   Alcotest.check (Alcotest.list ty) "should be equal" right left
 
-let case title fn = Alcotest_lwt.test_case title `Quick fn
+let test title fn = Alcotest_lwt.test_case title `Quick fn
 
 let assert_stream (stream : string Lwt_stream.t) expected =
   let open Lwt.Infix in
@@ -47,7 +47,7 @@ let react_use_without_suspense _switch () =
               [ React.string "Hello "; React.float delay ];
           ])
   in
-  let stream, _abort = ReactDOM.renderToLwtStream app in
+  let%lwt stream, _abort = ReactDOM.renderToLwtStream app in
   assert_stream stream [ "<div><span>Hello 0.1</span></div>" ]
 
 let suspense_without_promise _switch () =
@@ -60,7 +60,7 @@ let suspense_without_promise _switch () =
   let app =
     React.Suspense { fallback = React.string "Loading..."; children = hi }
   in
-  let stream, _abort = ReactDOM.renderToLwtStream app in
+  let%lwt stream, _abort = ReactDOM.renderToLwtStream app in
   assert_stream stream [ "<div><span>Hello</span></div>" ]
 
 let suspense_with_always_throwing _switch () =
@@ -70,7 +70,7 @@ let suspense_with_always_throwing _switch () =
   let app =
     React.Suspense { fallback = React.string "Loading..."; children = hi }
   in
-  let stream, _abort = ReactDOM.renderToLwtStream app in
+  let%lwt stream, _abort = ReactDOM.renderToLwtStream app in
   assert_stream stream
     [ "<!--$?--><template id='B:0'></template>Loading...<!--/$-->" ]
 
@@ -90,7 +90,7 @@ let react_use_with_suspense _switch () =
   let app =
     React.Suspense { fallback = React.string "Loading..."; children = time }
   in
-  let stream, _abort = ReactDOM.renderToLwtStream app in
+  let%lwt stream, _abort = ReactDOM.renderToLwtStream app in
   assert_stream stream
     [
       "<!--$?--><template id='B:0'></template>Loading...<!--/$-->";
@@ -111,7 +111,7 @@ let test_with_custom_component _switch () =
           [ React.createElement "span" [] [ React.string "Custom Component" ] ])
   in
   let app = React.createElement "div" [] [ custom_component ] in
-  let stream, _abort = ReactDOM.renderToLwtStream app in
+  let%lwt stream, _abort = ReactDOM.renderToLwtStream app in
   assert_stream stream [ "<div><div><span>Custom Component</span></div></div>" ]
 
 let test_with_multiple_custom_components _switch () =
@@ -124,19 +124,29 @@ let test_with_multiple_custom_components _switch () =
   let app =
     React.createElement "div" [] [ custom_component; custom_component ]
   in
-  let stream, _abort = ReactDOM.renderToLwtStream app in
+  let%lwt stream, _abort = ReactDOM.renderToLwtStream app in
   assert_stream stream
     [
       "<div><div><span>Custom Component</span></div><div><span>Custom \
        Component</span></div></div>";
     ]
 
+let async_component _switch () =
+  let app =
+    React.Async_component
+      (fun () ->
+        Lwt.return (React.createElement "span" [] [ React.string "yow" ]))
+  in
+  let%lwt stream, _abort = ReactDOM.renderToLwtStream app in
+  assert_stream stream [ "<span>yow</span>" ]
+
 let tests =
   ( "renderToLwtStream",
     [
-      case "test_silly_stream" test_silly_stream;
-      (* case "react_use_without_suspense" react_use_without_suspense; *)
-      case "suspense_with_always_throwing" suspense_with_always_throwing;
-      case "suspense_without_promise" suspense_without_promise;
-      case "react_use_with_suspense" react_use_with_suspense;
+      test "test_silly_stream" test_silly_stream;
+      (* test "react_use_without_suspense" react_use_without_suspense; *)
+      test "suspense_with_always_throwing" suspense_with_always_throwing;
+      test "suspense_without_promise" suspense_without_promise;
+      test "react_use_with_suspense" react_use_with_suspense;
+      test "async component" async_component;
     ] )

packages/reactDom/test/test_renderToStaticMarkup.ml

@@ -296,6 +296,7 @@ let render_svg () =
      L 19 6.4140625 L 19 10 L 21 10 L 21 3 L 14 3 z\"></path></svg>"
 
 let test title fn = Alcotest_lwt.test_case_sync title `Quick fn
+let async_test title fn = Alcotest_lwt.test_case title `Quick fn
 
 (* TODO: add cases for React.Suspense
    function Button() {
@@ -345,6 +346,20 @@ let ref_as_prop_works () =
   in
   assert_string (ReactDOM.renderToStaticMarkup app) "<span>yow</span>"
 
+let async_component () =
+  let app =
+    React.Async_component
+      (fun () ->
+        Lwt.return (React.createElement "span" [] [ React.string "yow" ]))
+  in
+  Alcotest.check_raises "wat"
+    (Failure
+       "Asyncronous components can't be rendered to static markup, since \
+        rendering is syncronous. Please use `renderToLwtStream` instead.")
+    (fun () ->
+      let _ : string = ReactDOM.renderToStaticMarkup app in
+      ())
+
 let tests =
   ( "renderToStaticMarkup",
     [
@@ -378,4 +393,5 @@ let tests =
       test "render_svg" render_svg;
       test "ref_as_prop_works" ref_as_prop_works;
       test "ref_as_callback_prop_works" ref_as_callback_prop_works;
+      test "async" async_component;
     ] )