From 20cc3637c7268ceb8ca18ce55027ad8584e1cfd8 Mon Sep 17 00:00:00 2001 From: polwex Date: Sun, 22 Jun 2025 14:32:59 +0700 Subject: checkpoint --- bs5/client/dune | 20 ++-- bs5/dune | 6 - bs5/js/tailwind.config.js | 2 +- bs5/packages/extract-client-components/dune | 4 + .../extract-client-components/esbuild-plugin.mjs | 89 ++++++++++++++ .../extract_client_components.ml | 129 +++++++++++++++++++++ bs5/server/dune | 2 - bs5/server/middleware/logs.ml | 14 ++- bs5/server/pages/Hydrate.re | 2 +- bs5/server/pages/Index.re | 2 +- bs5/server/pages/RouterRSC.re | 27 +++-- bs5/server/pages/ServerOnlyRSC.re | 4 +- bs5/server/pages/SinglePageRSC.re | 2 +- bs5/server/server.ml | 9 +- bs5/universal/js/dune | 2 +- bs5/universal/native/shared/Router.re | 12 +- 16 files changed, 268 insertions(+), 58 deletions(-) create mode 100644 bs5/packages/extract-client-components/dune create mode 100644 bs5/packages/extract-client-components/esbuild-plugin.mjs create mode 100644 bs5/packages/extract-client-components/extract_client_components.ml 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 = ; +let doc = ; 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"], , 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( - - - - - //