checkpoint

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),