summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--bs5/client/dune20
-rw-r--r--bs5/dune6
-rw-r--r--bs5/js/tailwind.config.js2
-rw-r--r--bs5/packages/extract-client-components/dune4
-rw-r--r--bs5/packages/extract-client-components/esbuild-plugin.mjs89
-rw-r--r--bs5/packages/extract-client-components/extract_client_components.ml129
-rw-r--r--bs5/server/dune2
-rw-r--r--bs5/server/middleware/logs.ml14
-rw-r--r--bs5/server/pages/Hydrate.re2
-rw-r--r--bs5/server/pages/Index.re2
-rw-r--r--bs5/server/pages/RouterRSC.re27
-rw-r--r--bs5/server/pages/ServerOnlyRSC.re4
-rw-r--r--bs5/server/pages/SinglePageRSC.re2
-rw-r--r--bs5/server/server.ml9
-rw-r--r--bs5/universal/js/dune2
-rw-r--r--bs5/universal/native/shared/Router.re12
16 files changed, 268 insertions, 58 deletions
diff --git a/bs5/client/dune b/bs5/client/dune
index 669e755..1f50d49 100644
--- a/bs5/client/dune
+++ b/bs5/client/dune
@@ -4,8 +4,6 @@
("DEMO_ENV" "development"))))
(melange.emit
- (enabled_if
- (= %{profile} dev))
(target app)
(module_systems
(es6 re.js))
@@ -16,31 +14,29 @@
melange-webapi
server-reason-react.url_js
melange-fetch
- demo_shared_js)
+ shared_js)
(preprocess
(pps server-reason-react.browser_ppx -js reason-react-ppx melange.ppx)))
(rule
- (enabled_if
- (= %{profile} dev))
(alias client)
(deps
- (package bs-5)
+ (package bs5)
(alias_rec melange)
(:script build.mjs)
(:entrypoints
- "app/demo/client/Hydrate.re.js"
- "app/demo/client/SinglePageRSC.re.js"
- "app/demo/client/RouterRSC.re.js"
- "app/demo/client/ServerOnlyRSC.re.js")
+ "app/client/Hydrate.re.js"
+ "app/client/SinglePageRSC.re.js"
+ "app/client/RouterRSC.re.js"
+ "app/client/ServerOnlyRSC.re.js")
(source_tree node_modules)
(file package.json)
- (source_tree ../../packages/extract-client-components))
+ (source_tree ../packages/extract-client-components))
(action
(run
node
%{script}
%{entrypoints}
- --output=app/demo/client/
+ --output=app/client/
--extract=true
--env=%{env:DEMO_ENV='production'})))
diff --git a/bs5/dune b/bs5/dune
index 8dc2bb1..a49c55c 100644
--- a/bs5/dune
+++ b/bs5/dune
@@ -1,7 +1,5 @@
(rule
(alias demo)
- (enabled_if
- (= %{profile} "dev"))
(deps
server/server.exe
(alias_rec client))
@@ -15,15 +13,11 @@
(install
(section bin)
- (enabled_if
- (= %{profile} dev))
(files
("./js/node_modules/@tailwindcss/cli/dist/index.mjs" as tailwind)))
(rule
(target output.css)
- (enabled_if
- (= %{profile} dev))
(alias client)
(deps
(source_tree ./)
diff --git a/bs5/js/tailwind.config.js b/bs5/js/tailwind.config.js
index eaa66bb..d40a867 100644
--- a/bs5/js/tailwind.config.js
+++ b/bs5/js/tailwind.config.js
@@ -1,7 +1,7 @@
/** @type {import('tailwindcss').Config} */
export default {
content: {
- files: ["./client/*.re","./server/*.re", "./universal/*.re"],
+ files: ["../client/*.re","../server/*.re", "../universal/*.re"],
},
plugins: {},
}
diff --git a/bs5/packages/extract-client-components/dune b/bs5/packages/extract-client-components/dune
new file mode 100644
index 0000000..3a105f3
--- /dev/null
+++ b/bs5/packages/extract-client-components/dune
@@ -0,0 +1,4 @@
+(executable
+ (name extract_client_components)
+ (public_name server_reason_react.extract_client_components)
+ (libraries unix cmdliner))
diff --git a/bs5/packages/extract-client-components/esbuild-plugin.mjs b/bs5/packages/extract-client-components/esbuild-plugin.mjs
new file mode 100644
index 0000000..cbc819c
--- /dev/null
+++ b/bs5/packages/extract-client-components/esbuild-plugin.mjs
@@ -0,0 +1,89 @@
+import Fs from "node:fs/promises";
+import Path from "node:path";
+import { execSync } from "node:child_process";
+
+async function generateBootstrapFile(output, content) {
+ let previousContent = undefined;
+ try {
+ previousContent = await Fs.readFile(output, "utf8");
+ } catch (e) {
+ if (e.code !== "ENOENT") {
+ throw e;
+ }
+ }
+ const contentHasChanged = previousContent !== content;
+ if (contentHasChanged) {
+ await Fs.writeFile(output, content, "utf8");
+ }
+}
+
+export function plugin(config) {
+ return {
+ name: "extract-client-components",
+ setup(build) {
+ if (
+ config.bootstrapOutput &&
+ typeof config.bootstrapOutput !== "string"
+ ) {
+ console.error("bootstrapOutput must be a string");
+ return;
+ }
+ const bootstrapOutput = config.bootstrapOutput || "./bootstrap.js";
+
+ if (!config.target) {
+ console.error("target is required");
+ return;
+ }
+ if (typeof config.target !== "string") {
+ console.error("target must be a string");
+ return;
+ }
+
+ build.onStart(async () => {
+ try {
+ /* TODO: Make sure `server_reason_react.extract_client_components` is available in $PATH */
+ const bootstrapContent = execSync(
+ `server_reason_react.extract_client_components ${config.target}`,
+ { encoding: "utf8" },
+ );
+ await generateBootstrapFile(bootstrapOutput, bootstrapContent);
+ } catch (e) {
+ console.log("Extraction of client components failed:");
+ console.error(e);
+ return;
+ }
+ });
+
+ build.onResolve({ filter: /.*/ }, (args) => {
+ const isEntryPoint = args.kind === "entry-point";
+
+ if (isEntryPoint) {
+ return {
+ path: args.path,
+ namespace: "entrypoint",
+ };
+ }
+ return null;
+ });
+
+ build.onLoad({ filter: /.*/, namespace: "entrypoint" }, async (args) => {
+ const filePath = args.path.replace(/^entrypoint:/, "");
+ const entryPointContents = await Fs.readFile(filePath, "utf8");
+ const relativeBootstrapOutput = Path.relative(
+ Path.dirname(filePath),
+ bootstrapOutput,
+ );
+
+ const contents = `
+require("./${relativeBootstrapOutput}");
+${entryPointContents}`;
+
+ return {
+ loader: "jsx",
+ contents,
+ resolveDir: Path.dirname(Path.resolve(process.cwd(), filePath)),
+ };
+ });
+ },
+ };
+}
diff --git a/bs5/packages/extract-client-components/extract_client_components.ml b/bs5/packages/extract-client-components/extract_client_components.ml
new file mode 100644
index 0000000..d9a6953
--- /dev/null
+++ b/bs5/packages/extract-client-components/extract_client_components.ml
@@ -0,0 +1,129 @@
+module List = ListLabels
+
+let read_file path = try Some (In_channel.with_open_bin path In_channel.input_all) with _ -> None
+
+type manifest_item =
+ | Client_component of { original_path : string; compiled_js_path : string; module_name : string list option }
+ | Server_function of {
+ id : string;
+ compiled_js_path : string;
+ module_name : string list option;
+ function_name : string;
+ }
+
+let parse_module_name str = String.split_on_char '.' str
+let print_module_name str = String.concat "." str
+
+let parse_client_component_line line =
+ try
+ Scanf.sscanf line "// extract-client %s %s" (fun filename module_name ->
+ Ok (filename, if module_name = "" then None else Some (parse_module_name module_name)))
+ with End_of_file | Scanf.Scan_failure _ -> Error "Invalid `extract-client` command format"
+
+let parse_server_function_line line =
+ try
+ Scanf.sscanf line "// extract-server-function %s %s %s" (fun id function_name module_name ->
+ Ok ((if module_name = "" then None else Some (parse_module_name module_name)), function_name, id))
+ with End_of_file | Scanf.Scan_failure _ -> Error "Invalid `extract-server-function` command format"
+
+let parse_manifest_item ~path line =
+ match (parse_client_component_line (String.trim line), parse_server_function_line (String.trim line)) with
+ | Ok (original_path, module_name), _ ->
+ Some (Client_component { compiled_js_path = path; original_path; module_name })
+ | _, Ok (module_name, function_name, id) ->
+ Some (Server_function { compiled_js_path = path; module_name; function_name; id })
+ | Error _, Error _ -> None
+
+let parse_manifest_data ~path content : manifest_item list =
+ content |> String.split_on_char '\n' |> List.filter_map ~f:(parse_manifest_item ~path)
+
+let render_manifest manifest =
+ let register_client_modules =
+ List.map manifest ~f:(function
+ | Client_component { original_path; compiled_js_path; module_name } ->
+ let original_path_with_submodule =
+ match module_name with
+ | Some name -> Printf.sprintf "%s#%s" original_path (print_module_name name)
+ | None -> original_path
+ in
+ let export =
+ match module_name with
+ | Some name -> Printf.sprintf "%s.make_client" (print_module_name name)
+ | None -> "make_client"
+ in
+ Printf.sprintf
+ "window.__client_manifest_map[\"%s\"] = React.lazy(() => import(\"%s\").then(module => {\n\
+ \ return { default: module.%s }\n\
+ }).catch(err => { console.error(err); return { default: null }; }))"
+ original_path_with_submodule compiled_js_path export
+ | Server_function { compiled_js_path; module_name; function_name; id } ->
+ let export =
+ match module_name with
+ | Some name -> Printf.sprintf "%s.%s" (print_module_name name) function_name
+ | None -> function_name
+ in
+ Printf.sprintf "window.__server_functions_manifest_map[\"%s\"] = require(\"%s\").%s" id compiled_js_path
+ export)
+ in
+ Printf.sprintf
+ {|import React from "react";
+window.__client_manifest_map = window.__client_manifest_map || {};
+window.__server_functions_manifest_map = window.__server_functions_manifest_map || {};
+%s|}
+ (String.concat "\n" register_client_modules)
+
+(* TODO: Add parameter to allow users to configure the extension of the files *)
+let is_js_file path =
+ let ext = Filename.extension path in
+ ext = ".js" || ext = ".bs.js" || ext = ".jsx"
+
+(* TODO: refactor path to be a Filepath, not a string *)
+let capture_all_client_modules_files_in_target path =
+ let rec traverse_fs path =
+ try
+ match Sys.is_directory path with
+ | true ->
+ let contents = Sys.readdir path in
+ Array.fold_left
+ (fun acc entry ->
+ let full_path = Filename.concat path entry in
+ match acc with
+ | Ok files -> (
+ match traverse_fs full_path with Ok new_files -> Ok (files @ new_files) | Error err -> Error err)
+ | Error err -> Error err)
+ (Ok []) contents
+ | false ->
+ if is_js_file path then
+ match read_file path with
+ | Some content -> Ok (parse_manifest_data ~path content)
+ | None -> Error (Printf.sprintf "Failed to read file: %s" path)
+ else Ok []
+ with
+ | Sys_error msg -> Error (Printf.sprintf "System error: %s" msg)
+ | Unix.Unix_error (err, _, _) -> Error (Printf.sprintf "Unix error: %s" (Unix.error_message err))
+ | e -> Error (Printf.sprintf "Unexpected error: %s" (Printexc.to_string e))
+ in
+ traverse_fs path
+
+let melange_target =
+ let doc = "Path to the melange target directory (melange.emit (target xxx))" in
+ Cmdliner.Arg.(required & pos 0 (some string) None & info [] ~docv:"MELANGE_TARGET" ~doc)
+
+let extract_modules target =
+ let current_dir = Sys.getcwd () in
+ let melange_target = Filename.concat current_dir target in
+ match capture_all_client_modules_files_in_target melange_target with
+ | Ok manifest ->
+ print_endline (render_manifest manifest);
+ Ok ()
+ | Error msg -> Error (`Msg msg)
+
+let extract_cmd =
+ let open Cmdliner in
+ let doc = "Extract all client modules from a Melange target folder" in
+ let sdocs = Manpage.s_common_options in
+ let info = Cmd.info "extract-client-components" ~version:"1.0.0" ~doc ~sdocs in
+ let term = Term.(term_result (const extract_modules $ melange_target)) in
+ Cmd.v info term
+
+let () = exit (Cmdliner.Cmd.eval extract_cmd)
diff --git a/bs5/server/dune b/bs5/server/dune
index 19ff1eb..d0a8aca 100644
--- a/bs5/server/dune
+++ b/bs5/server/dune
@@ -1,8 +1,6 @@
; (include_subdirs qualified)
(executable
- (enabled_if
- (= %{profile} "dev"))
(name server)
(modules server)
(libraries
diff --git a/bs5/server/middleware/logs.ml b/bs5/server/middleware/logs.ml
index 6925ca4..ea69f89 100644
--- a/bs5/server/middleware/logs.ml
+++ b/bs5/server/middleware/logs.ml
@@ -1,12 +1,14 @@
let detailed_logger inner_handler request =
let method_str = Dream.method_to_string (Dream.method_ request) in
let path = Dream.target request in
- let user_agent = Dream.header request "User-Agent" |> Option.value ~default:"unknown" in
- let client_ip = Dream.client request in
- let%lwt () =
- Lwt_io.printf "%s %s %s - %s - %s\n" (Ptime_clock.now () |> Ptime.to_rfc3339) method_str path client_ip user_agent
- in
+ (* let user_agent = *)
+ (* Dream.header request "User-Agent" |> Option.value ~default:"unknown" *)
+ (* in *)
+ (* let client_ip = Dream.client request in *)
+ (* let%lwt () = *)
+ (* Lwt_io.printf "%s %s %s - %s - %s\n" (Ptime_clock.now () |> Ptime.to_rfc3339) method_str path client_ip user_agent *)
+ (* in *)
let%lwt response = inner_handler request in
let status = Dream.status response |> Dream.status_to_int in
- let%lwt () = Lwt_io.printf " -> %d\n" status in
+ let%lwt () = Lwt_io.printf "%s -%s -> %d\n" method_str path status in
Lwt.return response
diff --git a/bs5/server/pages/Hydrate.re b/bs5/server/pages/Hydrate.re
index f887e34..e7cf1dc 100644
--- a/bs5/server/pages/Hydrate.re
+++ b/bs5/server/pages/Hydrate.re
@@ -1,3 +1,3 @@
-let doc = <Document script="/static/demo/Hydrate.re.js"> <App /> </Document>;
+let doc = <Document script="/static/Hydrate.re.js"> <App /> </Document>;
let toString = ReactDOM.renderToString(doc);
let toStatic = ReactDOM.renderToStaticMarkup(doc);
diff --git a/bs5/server/pages/Index.re b/bs5/server/pages/Index.re
index 685069a..f6f2f56 100644
--- a/bs5/server/pages/Index.re
+++ b/bs5/server/pages/Index.re
@@ -226,7 +226,7 @@ module App = {
let handler = request =>
DreamRSC.create_from_request(
- ~bootstrap_modules=["/static/demo/SinglePageRSC.re.js"],
+ ~bootstrap_modules=["/static/SinglePageRSC.re.js"],
<App />,
request,
);
diff --git a/bs5/server/pages/RouterRSC.re b/bs5/server/pages/RouterRSC.re
index 390a8db..32ae375 100644
--- a/bs5/server/pages/RouterRSC.re
+++ b/bs5/server/pages/RouterRSC.re
@@ -92,19 +92,18 @@ module App = {
Lwt.return(
<html>
<head>
-
- <meta charSet="utf-8" />
- <link rel="stylesheet" href="/output.css" />
- </head>
- // <style
- // dangerouslySetInnerHTML={
- // "__html":
- // markdownStyles(
- // ~background=Theme.Color.gray2,
- // ~text=Theme.Color.gray12,
- // ),
- // }
- // />
+ <meta charSet="utf-8" />
+ <link rel="stylesheet" href="/output.css" />
+ </head>
+ // <style
+ // dangerouslySetInnerHTML={
+ // "__html":
+ // markdownStyles(
+ // ~background=Theme.Color.gray2,
+ // ~text=Theme.Color.gray12,
+ // ),
+ // }
+ // />
<body>
<div id="root">
<DemoLayout background=Theme.Color.Gray2 mode=FullScreen>
@@ -179,7 +178,7 @@ let handler = request => {
Dream.query(request, "searchText") |> Option.value(~default="");
Rsc.DreamRSC.create_from_request(
- ~bootstrap_modules=["/static/demo/RouterRSC.re.js"],
+ ~bootstrap_modules=["/static/RouterRSC.re.js"],
<App selectedId isEditing searchText />,
request,
);
diff --git a/bs5/server/pages/ServerOnlyRSC.re b/bs5/server/pages/ServerOnlyRSC.re
index 8e166aa..967cfcd 100644
--- a/bs5/server/pages/ServerOnlyRSC.re
+++ b/bs5/server/pages/ServerOnlyRSC.re
@@ -37,9 +37,7 @@ let handler = request => {
} else {
Dream.html(
ReactDOM.renderToString(
- <Document script="/static/demo/ServerOnlyRSC.re.js">
- React.null
- </Document>,
+ <Document script="/static/ServerOnlyRSC.re.js"> React.null </Document>,
),
);
};
diff --git a/bs5/server/pages/SinglePageRSC.re b/bs5/server/pages/SinglePageRSC.re
index 685069a..f6f2f56 100644
--- a/bs5/server/pages/SinglePageRSC.re
+++ b/bs5/server/pages/SinglePageRSC.re
@@ -226,7 +226,7 @@ module App = {
let handler = request =>
DreamRSC.create_from_request(
- ~bootstrap_modules=["/static/demo/SinglePageRSC.re.js"],
+ ~bootstrap_modules=["/static/SinglePageRSC.re.js"],
<App />,
request,
);
diff --git a/bs5/server/server.ml b/bs5/server/server.ml
index c7c18e9..a58abc5 100644
--- a/bs5/server/server.ml
+++ b/bs5/server/server.ml
@@ -13,11 +13,12 @@ let router =
([
(* rendering tricks *)
Dream.get "/output.css"
- (Dream.from_filesystem "./_build/default/demo" "output.css");
- Dream.get "/static/**" (Dream.static "./_build/default/client/app");
+ (Dream.from_filesystem "./_build/default" "output.css");
+ Dream.get "/static/**"
+ (Dream.static "./_build/default/client/app/client");
getAndPost Router.demoRenderToString (fun _ ->
Dream.html Pages.Hydrate.toString);
- getAndPost Router.demoRenderToString (fun _ ->
+ getAndPost Router.demoRenderToStaticMarkup (fun _ ->
Dream.html Pages.Hydrate.toStatic);
(* more demos *)
getAndPost Router.demoRenderToStream Pages.Comments.handler;
@@ -34,7 +35,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.Index.handler;
+ Dream.get "/" Pages.Home.handler;
]
@ Api.Json.routes @ Api.Stream.streams)
diff --git a/bs5/universal/js/dune b/bs5/universal/js/dune
index 20b7dd2..ac01ca9 100644
--- a/bs5/universal/js/dune
+++ b/bs5/universal/js/dune
@@ -1,5 +1,5 @@
(library
- (name demo_shared_js)
+ (name shared_js)
(modes melange)
(wrapped false)
(libraries
diff --git a/bs5/universal/native/shared/Router.re b/bs5/universal/native/shared/Router.re
index 7b814a6..a1cbf20 100644
--- a/bs5/universal/native/shared/Router.re
+++ b/bs5/universal/native/shared/Router.re
@@ -1,10 +1,10 @@
let home = "/";
-let demoRenderToStaticMarkup = "/demo/render-to-static-markup";
-let demoRenderToString = "/demo/render-to-string";
-let demoRenderToStream = "/demo/render-to-stream";
-let demoServerOnlyRSC = "/demo/server-only-rsc";
-let demoSinglePageRSC = "/demo/single-page-rsc";
-let demoRouterRSC = "/demo/router-rsc";
+let demoRenderToStaticMarkup = "/render-to-static-markup";
+let demoRenderToString = "/render-to-string";
+let demoRenderToStream = "/render-to-stream";
+let demoServerOnlyRSC = "/server-only-rsc";
+let demoSinglePageRSC = "/single-page-rsc";
+let demoRouterRSC = "/router-rsc";
let links = [|
("Server side render to string (renderToString)", demoRenderToString),
generated by cgit v1.2.3 (git 2.25.1) at 2025-08-15 12:54:54 +0000