From f13574dc6661dba88a64580942f0c62cd42f63d7 Mon Sep 17 00:00:00 2001 From: polwex Date: Sun, 15 Jun 2025 01:21:21 +0700 Subject: server working! kinda! --- bs5/server/DreamRSC.ml | 134 --------------------------------------------- bs5/server/dune | 3 + bs5/server/pages/Index.re | 24 +++++++- bs5/server/pages/dune | 1 + bs5/server/rsc/DreamRSC.ml | 134 +++++++++++++++++++++++++++++++++++++++++++++ bs5/server/rsc/dune | 10 ++++ bs5/server/server.ml | 2 +- 7 files changed, 172 insertions(+), 136 deletions(-) delete mode 100644 bs5/server/DreamRSC.ml create mode 100644 bs5/server/rsc/DreamRSC.ml create mode 100644 bs5/server/rsc/dune diff --git a/bs5/server/DreamRSC.ml b/bs5/server/DreamRSC.ml deleted file mode 100644 index 40fa9a8..0000000 --- a/bs5/server/DreamRSC.ml +++ /dev/null @@ -1,134 +0,0 @@ -open Function_references - -let debug = Sys.getenv_opt "DEMO_ENV" == Some "development" - -let handle_form_request action_id form_data = - let form_data = - let form_data_js = Js.FormData.make () in - form_data - |> List.iter (fun (name, value) -> - (* For now we're only supporting strings. *) - let _filename, value = value |> List.hd in - Js.FormData.append form_data_js name (`String value)); - form_data_js - in - - let args, form_data = ReactServerDOM.decodeFormDataReply form_data in - - let action_id = - match action_id with - | Some action_id -> action_id - | None -> failwith "We don't support progressive enhancement yet." - in - - let handler = - match FunctionReferences.get action_id with - | Some (FormData handler) -> handler - | _ -> assert false - in - handler args form_data - -let handle_request_body request action_id = - let%lwt body = Dream.body request in - let action_id = - match action_id with - | Some action_id -> action_id - | None -> - failwith - "Missing action ID, this request was not created by \ - server-reason-react" - in - let handler = - match FunctionReferences.get action_id with - | Some (Body handler) -> handler - | _ -> assert false - in - - handler (ReactServerDOM.decodeReply body) - -let handle_request request = - let action_id = Dream.header request "ACTION_ID" in - let content_type = Dream.header request "Content-Type" in - - match content_type with - | Some content_type - when String.starts_with content_type ~prefix:"multipart/form-data" -> ( - let%lwt result = Dream.multipart request ~csrf:false in - match result with - | `Ok form_data -> handle_form_request action_id form_data - | _ -> - failwith - "Missing form data, this request was not created by \ - server-reason-react") - | _ -> handle_request_body request action_id - -let stream_function_response request = - Dream.stream - ~headers:[ ("Content-Type", "application/react.action") ] - (fun stream -> - let%lwt () = - ReactServerDOM.create_action_response - ~subscribe:(fun chunk -> - Dream.log "Action response"; - Dream.log "%s" chunk; - let%lwt () = Dream.write stream chunk in - Dream.flush stream) - (handle_request request) - in - - Dream.flush stream) - -let is_react_component_header str = - String.equal str "application/react.component" - -let stream_model ~location app = - Dream.stream - ~headers: - [ - ("Content-Type", "application/react.component"); - ("X-Content-Type-Options", "nosniff"); - ("X-Location", location); - ] - (fun stream -> - let%lwt () = - ReactServerDOM.render_model ~debug - ~subscribe:(fun chunk -> - Dream.log "Chunk"; - Dream.log "%s" chunk; - let%lwt () = Dream.write stream chunk in - Dream.flush stream) - app - in - - Dream.flush stream) - -let stream_html ~bootstrap_script_content ~bootstrap_scripts ~bootstrap_modules - app = - Dream.stream - ~headers:[ ("Content-Type", "text/html") ] - (fun stream -> - let%lwt html, subscribe = - ReactServerDOM.render_html - ~bootstrapScriptContent:bootstrap_script_content - ~bootstrapScripts:bootstrap_scripts - ~bootstrapModules:bootstrap_modules ~debug app - in - let%lwt () = Dream.write stream html in - let%lwt () = Dream.flush stream in - let%lwt () = - subscribe (fun chunk -> - Dream.log "Chunk"; - Dream.log "%s" chunk; - let%lwt () = Dream.write stream chunk in - Dream.flush stream) - in - Dream.flush stream) - -let create_from_request ?(bootstrap_modules = []) ?(bootstrap_scripts = []) - ?(bootstrap_script_content = "") app request = - match Dream.header request "Accept" with - | Some accept when is_react_component_header accept -> - stream_model ~location:(Dream.target request) app - | _ -> - stream_html ~bootstrap_script_content ~bootstrap_scripts - ~bootstrap_modules app diff --git a/bs5/server/dune b/bs5/server/dune index 3438c1c..9565f90 100644 --- a/bs5/server/dune +++ b/bs5/server/dune @@ -4,11 +4,14 @@ (enabled_if (= %{profile} "dev")) (name server) + (modules server) (libraries ; local middleware api function_references + rsc + pages ; dream server-reason-react.belt diff --git a/bs5/server/pages/Index.re b/bs5/server/pages/Index.re index 20dfbff..d5af822 100644 --- a/bs5/server/pages/Index.re +++ b/bs5/server/pages/Index.re @@ -15,4 +15,26 @@ module Page = { }; }; -// let handler = request => DreamRSC.create; +module App = { + [@react.component] + let make = () => { + + + + + + +
+ // +
+ + ; + }; +}; + +let handler = request => + Rsc.DreamRSC.create_from_request( + ~bootstrap_modules=["/static/demo/SinglePageRSC.re.js"], + , + request, + ); diff --git a/bs5/server/pages/dune b/bs5/server/pages/dune index 4d54676..bc63199 100644 --- a/bs5/server/pages/dune +++ b/bs5/server/pages/dune @@ -1,6 +1,7 @@ (library (name pages) (libraries + rsc dream lwt.unix server-reason-react.belt diff --git a/bs5/server/rsc/DreamRSC.ml b/bs5/server/rsc/DreamRSC.ml new file mode 100644 index 0000000..40fa9a8 --- /dev/null +++ b/bs5/server/rsc/DreamRSC.ml @@ -0,0 +1,134 @@ +open Function_references + +let debug = Sys.getenv_opt "DEMO_ENV" == Some "development" + +let handle_form_request action_id form_data = + let form_data = + let form_data_js = Js.FormData.make () in + form_data + |> List.iter (fun (name, value) -> + (* For now we're only supporting strings. *) + let _filename, value = value |> List.hd in + Js.FormData.append form_data_js name (`String value)); + form_data_js + in + + let args, form_data = ReactServerDOM.decodeFormDataReply form_data in + + let action_id = + match action_id with + | Some action_id -> action_id + | None -> failwith "We don't support progressive enhancement yet." + in + + let handler = + match FunctionReferences.get action_id with + | Some (FormData handler) -> handler + | _ -> assert false + in + handler args form_data + +let handle_request_body request action_id = + let%lwt body = Dream.body request in + let action_id = + match action_id with + | Some action_id -> action_id + | None -> + failwith + "Missing action ID, this request was not created by \ + server-reason-react" + in + let handler = + match FunctionReferences.get action_id with + | Some (Body handler) -> handler + | _ -> assert false + in + + handler (ReactServerDOM.decodeReply body) + +let handle_request request = + let action_id = Dream.header request "ACTION_ID" in + let content_type = Dream.header request "Content-Type" in + + match content_type with + | Some content_type + when String.starts_with content_type ~prefix:"multipart/form-data" -> ( + let%lwt result = Dream.multipart request ~csrf:false in + match result with + | `Ok form_data -> handle_form_request action_id form_data + | _ -> + failwith + "Missing form data, this request was not created by \ + server-reason-react") + | _ -> handle_request_body request action_id + +let stream_function_response request = + Dream.stream + ~headers:[ ("Content-Type", "application/react.action") ] + (fun stream -> + let%lwt () = + ReactServerDOM.create_action_response + ~subscribe:(fun chunk -> + Dream.log "Action response"; + Dream.log "%s" chunk; + let%lwt () = Dream.write stream chunk in + Dream.flush stream) + (handle_request request) + in + + Dream.flush stream) + +let is_react_component_header str = + String.equal str "application/react.component" + +let stream_model ~location app = + Dream.stream + ~headers: + [ + ("Content-Type", "application/react.component"); + ("X-Content-Type-Options", "nosniff"); + ("X-Location", location); + ] + (fun stream -> + let%lwt () = + ReactServerDOM.render_model ~debug + ~subscribe:(fun chunk -> + Dream.log "Chunk"; + Dream.log "%s" chunk; + let%lwt () = Dream.write stream chunk in + Dream.flush stream) + app + in + + Dream.flush stream) + +let stream_html ~bootstrap_script_content ~bootstrap_scripts ~bootstrap_modules + app = + Dream.stream + ~headers:[ ("Content-Type", "text/html") ] + (fun stream -> + let%lwt html, subscribe = + ReactServerDOM.render_html + ~bootstrapScriptContent:bootstrap_script_content + ~bootstrapScripts:bootstrap_scripts + ~bootstrapModules:bootstrap_modules ~debug app + in + let%lwt () = Dream.write stream html in + let%lwt () = Dream.flush stream in + let%lwt () = + subscribe (fun chunk -> + Dream.log "Chunk"; + Dream.log "%s" chunk; + let%lwt () = Dream.write stream chunk in + Dream.flush stream) + in + Dream.flush stream) + +let create_from_request ?(bootstrap_modules = []) ?(bootstrap_scripts = []) + ?(bootstrap_script_content = "") app request = + match Dream.header request "Accept" with + | Some accept when is_react_component_header accept -> + stream_model ~location:(Dream.target request) app + | _ -> + stream_html ~bootstrap_script_content ~bootstrap_scripts + ~bootstrap_modules app diff --git a/bs5/server/rsc/dune b/bs5/server/rsc/dune new file mode 100644 index 0000000..fc73cd0 --- /dev/null +++ b/bs5/server/rsc/dune @@ -0,0 +1,10 @@ +(library + (name rsc) + (libraries + function_references + dream + lwt + server-reason-react.js + server-reason-react.reactDom) + (preprocess + (pps lwt_ppx ppx_yojson_conv))) diff --git a/bs5/server/server.ml b/bs5/server/server.ml index 40834b9..2047624 100644 --- a/bs5/server/server.ml +++ b/bs5/server/server.ml @@ -12,7 +12,7 @@ let router = Dream.post "/echo" (fun req -> let%lwt body = Dream.body req in Dream.respond ~headers:[ ("Content-Type", "application/json") ] body); - (* Dream.get "/" Pages. *) + Dream.get "/" Pages.Index.handler; ] @ Api.Json.routes @ Api.Stream.streams) -- cgit v1.2.3