coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions 7 Packages Projects Releases Wiki Activity

Step 17: streaming render — hyperscript enhancements, WASM builds, live server tests

Browse Source 
Streaming chunked transfer with shell-first suspense and resolve scripts.
Hyperscript parser/compiler/runtime expanded for conformance. WASM static
assets added to OCaml host. Playwright streaming and page-level test suites.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-12 08:41:38 +00:00
parent 7aefe4da8f
commit 6e27442d57
29 changed files with 65959 additions and 628 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
hosts/ocaml/bin/dune
View File

@@ -1,6 +1,6 @@
(executables
(names run_tests debug_set sx_server integration_tests)
(libraries sx unix))
(libraries sx unix threads.posix))
(executable
(name mcp_tree)

64
hosts/ocaml/bin/sx_server.ml
View File

@@ -151,6 +151,9 @@ let _app_config : (string, value) Hashtbl.t option ref = ref None
let _defpage_paths : string list ref = ref []
(* Streaming pages: path → page name, for pages with :stream true *)
let _streaming_pages : (string, string) Hashtbl.t = Hashtbl.create 8
(* Mutex to serialize streaming renders — OCaml threads share the runtime
lock, and concurrent CEK evaluations corrupt shared state. *)
let _stream_mutex = Mutex.create ()
let get_app_config key default =
match !_app_config with
@@ -1746,7 +1749,7 @@ let http_redirect url =
let http_chunked_header ?(status=200) ?(content_type="text/html; charset=utf-8") () =
let status_text = match status with
| 200 -> "OK" | 404 -> "Not Found" | 500 -> "Internal Server Error" | _ -> "Unknown" in
Printf.sprintf "HTTP/1.1 %d %s\r\nContent-Type: %s\r\nTransfer-Encoding: chunked\r\nConnection: keep-alive\r\n\r\n"
Printf.sprintf "HTTP/1.1 %d %s\r\nContent-Type: %s\r\nTransfer-Encoding: chunked\r\nConnection: keep-alive\r\nX-Accel-Buffering: no\r\nCache-Control: no-cache, no-transform\r\n\r\n"
status status_text content_type
let write_chunk fd data =
@@ -1755,13 +1758,14 @@ let write_chunk fd data =
let bytes = Bytes.of_string chunk in
let total = Bytes.length bytes in
let written = ref 0 in
(try
try
while !written < total do
let n = Unix.write fd bytes !written (total - !written) in
written := !written + n
done
with Unix.Unix_error _ -> ())
end
done;
true
with Unix.Unix_error _ -> false
end else true
let end_chunked fd =
(try ignore (Unix.write_substring fd "0\r\n\r\n" 0 5) with Unix.Unix_error _ -> ());
@@ -2004,6 +2008,10 @@ let eval_with_io expr env =
(* ====================================================================== *)
let http_render_page_streaming env path _headers fd page_name =
(* No send timeout for streaming — the alive check in write_chunk handles
broken pipe. Streaming clients may be slow to receive large shell chunks
while busy parsing/downloading other resources. *)
(try Unix.setsockopt_float fd Unix.SO_SNDTIMEO 30.0 with _ -> ());
let t0 = Unix.gettimeofday () in
let page_def = try
match env_get env ("page:" ^ page_name) with Dict d -> d | _ -> raise Not_found
@@ -2102,17 +2110,18 @@ let http_render_page_streaming env path _headers fd page_name =
let header = http_chunked_header () in
let header_bytes = Bytes.of_string header in
(try ignore (Unix.write fd header_bytes 0 (Bytes.length header_bytes)) with _ -> ());
write_chunk fd shell_body;
let alive = ref true in
alive := write_chunk fd shell_body;
(* Bootstrap resolve script — must come after shell so suspense elements exist *)
write_chunk fd _sx_streaming_bootstrap;
if !alive then alive := write_chunk fd _sx_streaming_bootstrap;
let t2 = Unix.gettimeofday () in
(* Phase 3: Evaluate :data, render :content, flush resolve scripts.
Uses eval_with_io so :data expressions can perform IO (e.g. sleep, fetch).
Each data item is resolved independently — IO in one item doesn't block others
from being flushed as they complete. *)
from being flushed as they complete. Bails out early on broken pipe. *)
let resolve_count = ref 0 in
if data_ast <> Nil && content_ast <> Nil then begin
if !alive && data_ast <> Nil && content_ast <> Nil then begin
(try
let data_result = eval_with_io data_ast env in
let t3_data = Unix.gettimeofday () in
@@ -2140,6 +2149,7 @@ let http_render_page_streaming env path _headers fd page_name =
Each item flushes its resolve script independently — the client sees
content appear progressively as each IO completes. *)
List.iter (fun (item, stream_id) ->
if !alive then
(try
(* IO sleep if delay specified — demonstrates async streaming *)
(match item with
@@ -2170,7 +2180,7 @@ let http_render_page_streaming env path _headers fd page_name =
let sx_source = match content_result with
| String s | SxExpr s -> s | _ -> serialize_value content_result in
let resolve_script = sx_streaming_resolve_script stream_id sx_source in
write_chunk fd resolve_script;
alive := write_chunk fd resolve_script;
incr resolve_count
with e ->
(* Error boundary: emit error fallback for this slot *)
@@ -2178,7 +2188,7 @@ let http_render_page_streaming env path _headers fd page_name =
Printf.eprintf "[sx-stream] resolve error for %s: %s\n%!" stream_id msg;
let error_sx = Printf.sprintf "(div :class \"text-rose-600 p-4 text-sm\" \"Error: %s\")"
(String.map (fun c -> if c = '"' then '\'' else c) msg) in
write_chunk fd (sx_streaming_resolve_script stream_id error_sx);
alive := write_chunk fd (sx_streaming_resolve_script stream_id error_sx);
incr resolve_count)
) data_items;
let t3 = Unix.gettimeofday () in
@@ -2190,7 +2200,7 @@ let http_render_page_streaming env path _headers fd page_name =
Printf.eprintf "[sx-stream] %s shell=%.3fs (no :data/:content)\n%!" path (t1 -. t0);
(* Phase 4: Send closing tags + end chunked response *)
if shell_tail <> "" then write_chunk fd shell_tail;
if !alive && shell_tail <> "" then ignore (write_chunk fd shell_tail);
end_chunked fd
(* ====================================================================== *)
@@ -2309,9 +2319,20 @@ let http_inject_shell_statics env static_dir sx_sxc =
) env.bindings;
let raw_defs = Buffer.contents buf in
(* Component-defs are inlined in <script type="text/sx">.
The escape_sx_string function handles </ → <\\/ inside string
literals, preventing the HTML parser from matching </script>. *)
let component_defs = raw_defs in
Escape </ → <\/ to prevent HTML parser from matching </script>. *)
let component_defs =
let len = String.length raw_defs in
let buf2 = Buffer.create (len + 64) in
for i = 0 to len - 1 do
if raw_defs.[i] = '<' && i + 1 < len && raw_defs.[i + 1] = '/' then begin
Buffer.add_string buf2 "<\\/";
end else if raw_defs.[i] = '/' && i > 0 && raw_defs.[i - 1] = '<' then
() (* skip — already handled above *)
else
Buffer.add_char buf2 raw_defs.[i]
done;
Buffer.contents buf2
in
let component_hash = Digest.string component_defs |> Digest.to_hex in
(* Compute per-file hashes for cache busting *)
let wasm_hash = file_hash (static_dir ^ "/wasm/sx_browser.bc.wasm.js") in
@@ -3428,11 +3449,14 @@ let http_mode port =
in
write_response fd response; true
end else begin
(* Full page streaming: chunked transfer encoding *)
(try http_render_page_streaming env path [] fd sname
with Exit -> () (* page def not found — already handled *)
| e -> Printf.eprintf "[sx-stream] unexpected error for %s: %s\n%!" path (Printexc.to_string e);
(try Unix.close fd with _ -> ()));
(* Full page streaming: run in a thread so the accept loop
stays unblocked for concurrent requests. *)
let _t = Thread.create (fun () ->
(try http_render_page_streaming env path [] fd sname
with Exit -> ()
| e -> Printf.eprintf "[sx-stream] unexpected error for %s: %s\n%!" path (Printexc.to_string e);
(try Unix.close fd with _ -> ()))
) () in
true
end
end else