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

SX request handler + AJAX nav + shared JIT globals + shell cleanup

Browse Source 
- Remove prism.js, sweetalert2, body.js, sx-browser.js from shell —
  only WASM kernel (sx_browser.bc.wasm.js + sx-platform.js) loads
- Restore request-handler.sx integration: SX handles routing + AJAX
  detection, OCaml does aser → SSR → shell render pipeline
- AJAX fragment support: SX-Request header returns content fragment
  (~14KB) instead of full page (~858KB), cached with "ajax:" prefix
- Fix language/applications/etc page functions to return empty fragment
  instead of nil (was causing 404s)
- Shared JIT VM globals: env_bind hook mirrors ALL bindings to a single
  shared globals table — eliminates stale-snapshot class of JIT bugs
- Add native `parse` function for components that need SX parsing
- Clean up unused shell params (sx-js-hash, body-js-hash, head-scripts,
  body-scripts, use-wasm) from shell.sx, helpers.py, and server.ml

14/32 Playwright tests pass (navigation, SSR, isomorphic, geography).
Remaining failures are client-side (WASM bytecode 404s block hydration).

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-30 03:03:57 +00:00
parent 847d04d4ba
commit 671d19c978
5 changed files with 246 additions and 307 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -569,6 +569,15 @@ let setup_type_constructors env =
let lo = int_of_float lo and hi = int_of_float hi in let lo = int_of_float lo and hi = int_of_float hi in
Number (float_of_int (lo + Random.int (max 1 (hi - lo + 1)))) Number (float_of_int (lo + Random.int (max 1 (hi - lo + 1))))
| _ -> raise (Eval_error "random-int: expected (low high)")); | _ -> raise (Eval_error "random-int: expected (low high)"));
bind "parse" (fun args ->
match args with
| [String s] | [SxExpr s] ->
let exprs = Sx_parser.parse_all s in
(match exprs with [e] -> e | _ -> List exprs)
| [v] ->
(* Already a value — return as-is *)
v
| _ -> raise (Eval_error "parse: expected string"));
bind "parse-int" (fun args -> bind "parse-int" (fun args ->
match args with match args with
| [String s] -> (try Number (float_of_int (int_of_string s)) with _ -> Nil) | [String s] -> (try Number (float_of_int (int_of_string s)) with _ -> Nil)
@@ -647,10 +656,19 @@ let setup_html_tags env =
(* ====================================================================== *) (* ====================================================================== *)
(** Convert int-keyed env.bindings to string-keyed Hashtbl for VM globals *) (** Convert int-keyed env.bindings to string-keyed Hashtbl for VM globals *)
let env_to_vm_globals env = (* Shared VM globals table — one live table, all JIT closures share
let g = Hashtbl.create (Hashtbl.length env.Sx_types.bindings) in the same reference. Kept in sync via env_bind hook so late-bound
Hashtbl.iter (fun id v -> Hashtbl.replace g (Sx_types.unintern id) v) env.Sx_types.bindings; values (shell statics, page functions, defines) are always visible. *)
g let _shared_vm_globals : (string, Sx_types.value) Hashtbl.t = Hashtbl.create 2048
let env_to_vm_globals _env = _shared_vm_globals
let () =
(* Hook env_bind globally so EVERY binding (from make_server_env, file loads,
component defs, shell statics, etc.) is mirrored to vm globals.
This eliminates the snapshot-staleness problem entirely. *)
Sx_types._env_bind_hook := Some (fun _env name v ->
Hashtbl.replace _shared_vm_globals name v)
let make_server_env () = let make_server_env () =
let env = make_env () in let env = make_env () in
@@ -1462,142 +1480,123 @@ let url_decode s =
done; done;
Buffer.contents buf Buffer.contents buf
(** Render a page from an SX URL path. Returns HTML or None. *) let parse_http_headers data =
let http_render_page env path = let lines = String.split_on_char '\n' data in
let headers = ref [] in
List.iter (fun line ->
let line = if String.length line > 0 && line.[String.length line - 1] = '\r'
then String.sub line 0 (String.length line - 1) else line in
match String.index_opt line ':' with
| Some i when i > 0 ->
let key = String.trim (String.sub line 0 i) in
let value = String.trim (String.sub line (i + 1) (String.length line - i - 1)) in
headers := (key, value) :: !headers
| _ -> ()
) (match lines with _ :: rest -> rest | [] -> []);
!headers
(** Render a page. Routing + AJAX detection in SX (request-handler.sx),
render pipeline (aser → SSR → shell) in OCaml for reliable env access. *)
let http_render_page env path headers =
let t0 = Unix.gettimeofday () in let t0 = Unix.gettimeofday () in
(* Parse the URL path to an SX expression *) (* Phase 0: Route via SX handler — returns {:is-ajax :nav-path :page-ast} *)
let path_expr = let handler = try env_get env "sx-handle-request" with _ -> Nil in
if path = "/" || path = "/sx/" || path = "/sx" then "home" if handler = Nil then (Printf.eprintf "[http] sx-handle-request not found\n%!"; None)
else begin else
let p = if String.length path > 4 && String.sub path 0 4 = "/sx/" then let headers_dict = Hashtbl.create 8 in
String.sub path 4 (String.length path - 4) List.iter (fun (k, v) ->
else if String.length path > 1 && path.[0] = '/' then Hashtbl.replace headers_dict (String.lowercase_ascii k) (String v)
String.sub path 1 (String.length path - 1) ) headers;
else path let route_result =
in try Sx_ref.cek_call handler
(* URL convention: dots → spaces *) (List [String path; Dict headers_dict; Env env; Nil])
String.map (fun c -> if c = '.' then ' ' else c) p
end
in
(* Auto-quote unknown symbols as strings (slug parameters).
e.g. (etc (plan sx-host)) → (etc (plan "sx-host"))
Matches Python's prepare_url_expr behavior. *)
let rec auto_quote expr =
match expr with
| Symbol s when not (env_has env s) && (try ignore (Sx_primitives.get_primitive s); false with _ -> true) ->
String s
| List items -> List (List.map auto_quote items)
| ListRef { contents = items } -> List (List.map auto_quote items)
| _ -> expr
in
(* Evaluate page function to get component call *)
let page_ast =
try
let exprs = Sx_parser.parse_all path_expr in
let expr = match exprs with [e] -> e | _ -> List exprs in
let quoted = auto_quote expr in
(* Bare symbols (like "home") → wrap in list to call as function.
e.g. home → (home), geography → (geography) *)
let callable = match quoted with
| Symbol _ -> List [quoted]
| _ -> quoted in
Sx_ref.eval_expr callable (Env env)
with e ->
Printf.eprintf "[http-route] eval failed for '%s': %s\n%!" path_expr (Printexc.to_string e);
Nil
in
if page_ast = Nil then None
else begin
(* Wrap: (~layouts/doc :path "/sx/..." content) → (~shared:layout/app-body :content wrapped) *)
let nav_path = if String.length path >= 4 && String.sub path 0 4 = "/sx/" then path
else "/sx" ^ path in
let wrapped = List [
Symbol "~layouts/doc"; Keyword "path"; String nav_path; page_ast
] in
let full_ast = List [
Symbol "~shared:layout/app-body"; Keyword "content"; wrapped
] in
let page_source = serialize_value full_ast in
let t1 = Unix.gettimeofday () in
(* Phase 1: aser — expand all components server-side.
expand-components? is pre-bound at startup (always true in HTTP mode). *)
let body_result =
let call = List [Symbol "aser"; List [Symbol "quote"; full_ast]; Env env] in
Sx_ref.eval_expr call (Env env)
in
let body_str = match body_result with
| String s | SxExpr s -> s
| _ -> serialize_value body_result
in
let t2 = Unix.gettimeofday () in
(* Phase 2: SSR — render to HTML using the SX adapter (render-to-html
from adapter-html.sx) via the CEK evaluator. This handles reactive
primitives (signals, deref, computed) correctly for island SSR.
Falls back to native Sx_render if the SX adapter isn't available. *)
let body_html =
try
let body_exprs = Sx_parser.parse_all body_str in
let body_expr = match body_exprs with
| [e] -> e | [] -> Nil | _ -> List (Symbol "<>" :: body_exprs) in
if env_has env "render-to-html" then begin
(* SX adapter — handles signals, islands, CSSX *)
let render_call = List [Symbol "render-to-html";
List [Symbol "quote"; body_expr];
Env env] in
let result = Sx_ref.eval_expr render_call (Env env) in
match result with
| String s | RawHTML s -> s
| _ -> Sx_runtime.value_to_str result
end else
(* Fallback: native renderer *)
Sx_render.sx_render_to_html env body_expr env
with e -> with e ->
Printf.eprintf "[http-ssr] failed for %s: %s\n%!" path (Printexc.to_string e); "" Printf.eprintf "[http] route error for %s: %s\n%!" path (Printexc.to_string e);
Nil
in in
let t3 = Unix.gettimeofday () in match route_result with
(* Phase 3: Shell — render directly to buffer for zero-copy output *) | Nil -> None
let get_shell_var name = try env_get env ("__shell-" ^ name) with _ -> Nil in | Dict d ->
let shell_args = [ let is_ajax = match Hashtbl.find_opt d "is-ajax" with Some (Bool true) -> true | _ -> false in
Keyword "title"; String "SX"; let nav_path = match Hashtbl.find_opt d "nav-path" with Some (String s) -> s | _ -> path in
Keyword "csrf"; String ""; let page_ast = match Hashtbl.find_opt d "page-ast" with Some v -> v | _ -> Nil in
Keyword "page-sx"; String page_source; if page_ast = Nil then None
Keyword "body-html"; String body_html; else begin
Keyword "component-defs"; get_shell_var "component-defs"; let wrapped = List [Symbol "~layouts/doc"; Keyword "path"; String nav_path; page_ast] in
Keyword "component-hash"; get_shell_var "component-hash"; if is_ajax then begin
Keyword "pages-sx"; get_shell_var "pages-sx"; (* AJAX: render content fragment only — no shell *)
Keyword "sx-css"; get_shell_var "sx-css"; let body_result =
Keyword "sx-css-classes"; get_shell_var "sx-css-classes"; let call = List [Symbol "aser"; List [Symbol "quote"; wrapped]; Env env] in
Keyword "asset-url"; get_shell_var "asset-url"; Sx_ref.eval_expr call (Env env) in
Keyword "sx-js-hash"; get_shell_var "sx-js-hash"; let body_str = match body_result with
Keyword "body-js-hash"; get_shell_var "body-js-hash"; | String s | SxExpr s -> s | _ -> serialize_value body_result in
Keyword "wasm-hash"; get_shell_var "wasm-hash"; let body_html = try
Keyword "head-scripts"; get_shell_var "head-scripts"; let body_expr = match Sx_parser.parse_all body_str with
Keyword "body-scripts"; get_shell_var "body-scripts"; | [e] -> e | [] -> Nil | es -> List (Symbol "<>" :: es) in
Keyword "inline-css"; get_shell_var "inline-css"; let render_call = List [Symbol "render-to-html";
Keyword "inline-head-js"; get_shell_var "inline-head-js"; List [Symbol "quote"; body_expr]; Env env] in
Keyword "init-sx"; get_shell_var "init-sx"; (match Sx_ref.eval_expr render_call (Env env) with
Keyword "use-wasm"; Bool (try Sys.getenv "SX_USE_WASM" = "1" with Not_found -> false); | String s | RawHTML s -> s | v -> Sx_runtime.value_to_str v)
Keyword "meta-html"; String ""; with e -> Printf.eprintf "[http-ajax] ssr error: %s\n%!" (Printexc.to_string e); "" in
] in let t1 = Unix.gettimeofday () in
let shell_call = List (Symbol "~shared:shell/sx-page-shell" :: shell_args) in Printf.eprintf "[sx-http] %s AJAX %.3fs html=%d\n%!" path (t1 -. t0) (String.length body_html);
(* Use SX adapter for shell too — it's an SX component *) Some body_html
let html = end else begin
if env_has env "render-to-html" then begin (* Full page: aser → SSR → shell *)
let render_call = List [Symbol "render-to-html"; let full_ast = List [Symbol "~shared:layout/app-body"; Keyword "content"; wrapped] in
List [Symbol "quote"; shell_call]; let page_source = serialize_value full_ast in
Env env] in let t1 = Unix.gettimeofday () in
let result = Sx_ref.eval_expr render_call (Env env) in let body_result =
match result with let call = List [Symbol "aser"; List [Symbol "quote"; full_ast]; Env env] in
| String s | RawHTML s -> s Sx_ref.eval_expr call (Env env) in
| _ -> Sx_runtime.value_to_str result let body_str = match body_result with
end else | String s | SxExpr s -> s | _ -> serialize_value body_result in
Sx_render.sx_render_to_html env shell_call env let t2 = Unix.gettimeofday () in
in let body_html = try
let t4 = Unix.gettimeofday () in let body_expr = match Sx_parser.parse_all body_str with
Printf.eprintf "[sx-http] %s route=%.3fs aser=%.3fs ssr=%.3fs shell=%.3fs total=%.3fs html=%d\n%!" | [e] -> e | [] -> Nil | es -> List (Symbol "<>" :: es) in
path (t1 -. t0) (t2 -. t1) (t3 -. t2) (t4 -. t3) (t4 -. t0) (String.length html); if env_has env "render-to-html" then
Some html let render_call = List [Symbol "render-to-html";
end List [Symbol "quote"; body_expr]; Env env] in
(match Sx_ref.eval_expr render_call (Env env) with
| String s | RawHTML s -> s | v -> Sx_runtime.value_to_str v)
else Sx_render.sx_render_to_html env body_expr env
with e -> Printf.eprintf "[http-ssr] failed for %s: %s\n%!" path (Printexc.to_string e); "" in
let t3 = Unix.gettimeofday () in
let get_shell name = try env_get env ("__shell-" ^ name) with _ -> Nil in
let shell_args = [
Keyword "title"; String "SX"; Keyword "csrf"; String "";
Keyword "page-sx"; String page_source;
Keyword "body-html"; String body_html;
Keyword "component-defs"; get_shell "component-defs";
Keyword "component-hash"; get_shell "component-hash";
Keyword "pages-sx"; get_shell "pages-sx";
Keyword "sx-css"; get_shell "sx-css";
Keyword "sx-css-classes"; get_shell "sx-css-classes";
Keyword "asset-url"; get_shell "asset-url";
Keyword "wasm-hash"; get_shell "wasm-hash";
Keyword "inline-css"; get_shell "inline-css";
Keyword "inline-head-js"; get_shell "inline-head-js";
Keyword "init-sx"; get_shell "init-sx";
Keyword "meta-html"; String "";
] in
let shell_call = List (Symbol "~shared:shell/sx-page-shell" :: shell_args) in
let html =
if env_has env "render-to-html" then
let render_call = List [Symbol "render-to-html";
List [Symbol "quote"; shell_call]; Env env] in
(match Sx_ref.eval_expr render_call (Env env) with
| String s | RawHTML s -> s | v -> Sx_runtime.value_to_str v)
else Sx_render.sx_render_to_html env shell_call env in
let t4 = Unix.gettimeofday () in
Printf.eprintf "[sx-http] %s route=%.3fs aser=%.3fs ssr=%.3fs shell=%.3fs total=%.3fs html=%d\n%!"
path (t1 -. t0) (t2 -. t1) (t3 -. t2) (t4 -. t3) (t4 -. t0) (String.length html);
Some html
end
end
| _ ->
Printf.eprintf "[http] unexpected handler result for %s\n%!" path;
None
(* ====================================================================== *) (* ====================================================================== *)
(* Static file serving + file hashing *) (* Static file serving + file hashing *)
@@ -1706,8 +1705,6 @@ let http_inject_shell_statics env static_dir sx_sxc =
let component_defs = raw_defs in let component_defs = raw_defs in
let component_hash = Digest.string component_defs |> Digest.to_hex in let component_hash = Digest.string component_defs |> Digest.to_hex in
(* Compute file hashes for cache busting *) (* Compute file hashes for cache busting *)
let sx_js_hash = file_hash (static_dir ^ "/scripts/sx-browser.js") in
let body_js_hash = file_hash (static_dir ^ "/scripts/body.js") in
let wasm_hash = file_hash (static_dir ^ "/wasm/sx_browser.bc.wasm.js") in let wasm_hash = file_hash (static_dir ^ "/wasm/sx_browser.bc.wasm.js") in
(* Read CSS for inline injection *) (* Read CSS for inline injection *)
let tw_css = read_css_file (static_dir ^ "/styles/tw.css") in let tw_css = read_css_file (static_dir ^ "/styles/tw.css") in
@@ -1761,11 +1758,7 @@ let http_inject_shell_statics env static_dir sx_sxc =
ignore (env_bind env "__shell-sx-css" (String sx_css)); ignore (env_bind env "__shell-sx-css" (String sx_css));
ignore (env_bind env "__shell-sx-css-classes" (String "")); ignore (env_bind env "__shell-sx-css-classes" (String ""));
ignore (env_bind env "__shell-asset-url" (String "/static")); ignore (env_bind env "__shell-asset-url" (String "/static"));
ignore (env_bind env "__shell-sx-js-hash" (String sx_js_hash));
ignore (env_bind env "__shell-body-js-hash" (String body_js_hash));
ignore (env_bind env "__shell-wasm-hash" (String wasm_hash)); ignore (env_bind env "__shell-wasm-hash" (String wasm_hash));
ignore (env_bind env "__shell-head-scripts" Nil);
ignore (env_bind env "__shell-body-scripts" Nil);
ignore (env_bind env "__shell-inline-css" Nil); ignore (env_bind env "__shell-inline-css" Nil);
ignore (env_bind env "__shell-inline-head-js" Nil); ignore (env_bind env "__shell-inline-head-js" Nil);
(* init-sx: trigger client-side render when sx-root is empty (SSR failed). (* init-sx: trigger client-side render when sx-root is empty (SSR failed).
@@ -1778,8 +1771,8 @@ let http_inject_shell_statics env static_dir sx_sxc =
SX.renderPage(); \ SX.renderPage(); \
} \ } \
});")); });"));
Printf.eprintf "[sx-http] Shell statics: defs=%d hash=%s css=%d js=%s wasm=%s\n%!" Printf.eprintf "[sx-http] Shell statics: defs=%d hash=%s css=%d wasm=%s\n%!"
(String.length component_defs) component_hash (String.length sx_css) sx_js_hash wasm_hash (String.length component_defs) component_hash (String.length sx_css) wasm_hash
let http_setup_declarative_stubs env = let http_setup_declarative_stubs env =
(* Stub declarative forms that are metadata-only — no-ops at render time. *) (* Stub declarative forms that are metadata-only — no-ops at render time. *)
@@ -1925,6 +1918,7 @@ let http_mode port =
lib_base ^ "/compiler.sx"; lib_base ^ "/compiler.sx";
web_base ^ "/adapter-html.sx"; web_base ^ "/adapter-sx.sx"; web_base ^ "/adapter-html.sx"; web_base ^ "/adapter-sx.sx";
web_base ^ "/web-forms.sx"; web_base ^ "/engine.sx"; web_base ^ "/web-forms.sx"; web_base ^ "/engine.sx";
web_base ^ "/request-handler.sx";
] in ] in
http_load_files env core_files; http_load_files env core_files;
(* Libraries *) (* Libraries *)
@@ -1961,8 +1955,6 @@ let http_mode port =
load_dir sx_sx; load_dir sx_sx;
let t1 = Unix.gettimeofday () in let t1 = Unix.gettimeofday () in
Printf.eprintf "[sx-http] All files loaded in %.3fs\n%!" (t1 -. t0); Printf.eprintf "[sx-http] All files loaded in %.3fs\n%!" (t1 -. t0);
(* Enable lazy JIT — compile lambdas to bytecode on first call *)
register_jit_hook env;
let jt0 = Unix.gettimeofday () in let jt0 = Unix.gettimeofday () in
let count = ref 0 in let count = ref 0 in
let compiler_names = [ let compiler_names = [
@@ -2022,6 +2014,10 @@ let http_mode port =
ignore (env_bind env "expand-components?" (NativeFn ("expand-components?", fun _args -> Bool true))); ignore (env_bind env "expand-components?" (NativeFn ("expand-components?", fun _args -> Bool true)));
(* Inject shell statics with real file hashes, CSS, and pages registry *) (* Inject shell statics with real file hashes, CSS, and pages registry *)
http_inject_shell_statics env static_dir sx_sxc; http_inject_shell_statics env static_dir sx_sxc;
(* Init shared VM globals AFTER all files loaded + shell statics injected.
The env_bind hook keeps it in sync with any future bindings. *)
(* Enable lazy JIT — compile lambdas to bytecode on first call *)
register_jit_hook env;
(* Response cache — path → full HTTP response string. (* Response cache — path → full HTTP response string.
Populated during pre-warm, serves cached responses in <0.1ms. Populated during pre-warm, serves cached responses in <0.1ms.
Thread-safe: reads are lock-free (Hashtbl.find_opt is atomic for Thread-safe: reads are lock-free (Hashtbl.find_opt is atomic for
@@ -2029,7 +2025,7 @@ let http_mode port =
let response_cache : (string, string) Hashtbl.t = Hashtbl.create 128 in let response_cache : (string, string) Hashtbl.t = Hashtbl.create 128 in
let cache_response path = let cache_response path =
match http_render_page env path with match http_render_page env path [] with
| Some html -> | Some html ->
let resp = http_response html in let resp = http_response html in
Hashtbl.replace response_cache path resp; Hashtbl.replace response_cache path resp;
@@ -2039,9 +2035,9 @@ let http_mode port =
in in
(* Pre-warm + cache all key pages *) (* Pre-warm + cache all key pages *)
let _warmup_paths = ["/sx/"; "/sx/(geography)"; "/sx/(geography.(reactive.(examples)))"; let _warmup_paths = ["/sx/"; "/sx/(geography)"; "/sx/(language)"; "/sx/(applications)";
"/sx/(geography.(reactive.(examples)))";
"/sx/(applications.(sxtp))"; "/sx/(geography.(cek))"; "/sx/(applications.(sxtp))"; "/sx/(geography.(cek))";
"/sx/(language)"; "/sx/(applications)";
"/sx/(geography.(reactive))"; "/sx/(geography.(hypermedia))"; "/sx/(geography.(reactive))"; "/sx/(geography.(hypermedia))";
] in ] in
let t_warm = Unix.gettimeofday () in let t_warm = Unix.gettimeofday () in
@@ -2086,7 +2082,7 @@ let http_mode port =
let n_workers = max 4 (Domain.recommended_domain_count ()) in let n_workers = max 4 (Domain.recommended_domain_count ()) in
(* Render queue: for cache misses that need full page render *) (* Render queue: for cache misses that need full page render *)
let render_queue : (Unix.file_descr * string) list ref = ref [] in let render_queue : (Unix.file_descr * string * (string * string) list) list ref = ref [] in
let render_mutex = Mutex.create () in let render_mutex = Mutex.create () in
let render_cond = Condition.create () in let render_cond = Condition.create () in
let shutdown = ref false in let shutdown = ref false in
@@ -2107,13 +2103,14 @@ let http_mode port =
w w
in in
match work with match work with
| Some (fd, path) -> | Some (fd, path, headers) ->
let cache_key = if headers <> [] then "ajax:" ^ path else path in
let response = let response =
try try
match http_render_page env path with match http_render_page env path headers with
| Some html -> | Some html ->
let resp = http_response html in let resp = http_response html in
Hashtbl.replace response_cache path resp; Hashtbl.replace response_cache cache_key resp;
resp resp
| None -> http_response ~status:404 "<h1>Not Found</h1>" | None -> http_response ~status:404 "<h1>Not Found</h1>"
with e -> with e ->
@@ -2127,7 +2124,7 @@ let http_mode port =
(* Fast path: handle a request from the main loop. (* Fast path: handle a request from the main loop.
Returns true if handled immediately (cached), false if queued. *) Returns true if handled immediately (cached), false if queued. *)
let fast_handle fd data _is_ajax = let fast_handle fd data is_ajax =
match parse_http_request data with match parse_http_request data with
| None -> write_response fd (http_response ~status:400 "Bad Request"); true | None -> write_response fd (http_response ~status:400 "Bad Request"); true
| Some (method_, raw_path) -> | Some (method_, raw_path) ->
@@ -2141,12 +2138,13 @@ let http_mode port =
let is_sx = path = "/sx/" || path = "/sx" let is_sx = path = "/sx/" || path = "/sx"
|| (String.length path > 4 && String.sub path 0 4 = "/sx/") in || (String.length path > 4 && String.sub path 0 4 = "/sx/") in
if is_sx then begin if is_sx then begin
(* Serve from cache (full page) — client handles sx-select extraction *) let cache_key = if is_ajax then "ajax:" ^ path else path in
match Hashtbl.find_opt response_cache path with match Hashtbl.find_opt response_cache cache_key with
| Some cached -> write_response fd cached; true | Some cached -> write_response fd cached; true
| None -> | None ->
let headers = if is_ajax then parse_http_headers data else [] in
Mutex.lock render_mutex; Mutex.lock render_mutex;
render_queue := !render_queue @ [(fd, path)]; render_queue := !render_queue @ [(fd, path, headers)];
Condition.signal render_cond; Condition.signal render_cond;
Mutex.unlock render_mutex; Mutex.unlock render_mutex;
false false

20
shared/sx/helpers.py
View File

@@ -883,16 +883,11 @@ def _get_shell_static() -> dict[str, Any]:
pages_sx=pages_sx, pages_sx=pages_sx,
sx_css=sx_css, sx_css=sx_css,
sx_css_classes=sx_css_classes, sx_css_classes=sx_css_classes,
sx_js_hash=_script_hash("sx-browser.js"),
body_js_hash=_script_hash("body.js"),
wasm_hash=_wasm_hash("sx_browser.bc.js"), wasm_hash=_wasm_hash("sx_browser.bc.js"),
asset_url=_ca.config.get("ASSET_URL", "/static"), asset_url=_ca.config.get("ASSET_URL", "/static"),
head_scripts=_shell_cfg.get("head_scripts"),
inline_css=_shell_cfg.get("inline_css"), inline_css=_shell_cfg.get("inline_css"),
inline_head_js=_shell_cfg.get("inline_head_js"), inline_head_js=_shell_cfg.get("inline_head_js"),
init_sx=_shell_cfg.get("init_sx"), init_sx=_shell_cfg.get("init_sx"),
body_scripts=_shell_cfg.get("body_scripts"),
use_wasm=os.environ.get("SX_USE_WASM") == "1",
) )
t1 = time.monotonic() t1 = time.monotonic()
@@ -1037,8 +1032,7 @@ def sx_page_streaming_parts(ctx: dict, page_html: str, *,
from quart import current_app from quart import current_app
pages_sx = _build_pages_sx(current_app.name) pages_sx = _build_pages_sx(current_app.name)
sx_js_hash = _script_hash("sx-browser.js") wasm_hash = _wasm_hash("sx_browser.bc.js")
body_js_hash = _script_hash("body.js")
# Shell: head + body with server-rendered HTML (not SX mount script) # Shell: head + body with server-rendered HTML (not SX mount script)
shell = ( shell = (
@@ -1053,11 +1047,6 @@ def sx_page_streaming_parts(ctx: dict, page_html: str, *,
f'<meta name="csrf-token" content="{_html_escape(csrf)}">\n' f'<meta name="csrf-token" content="{_html_escape(csrf)}">\n'
f'<style id="sx-css">{sx_css}</style>\n' f'<style id="sx-css">{sx_css}</style>\n'
f'<meta name="sx-css-classes" content="{sx_css_classes}">\n' f'<meta name="sx-css-classes" content="{sx_css_classes}">\n'
'<script src="https://unpkg.com/prismjs/prism.js"></script>\n'
'<script src="https://unpkg.com/prismjs/components/prism-javascript.min.js"></script>\n'
'<script src="https://unpkg.com/prismjs/components/prism-python.min.js"></script>\n'
'<script src="https://unpkg.com/prismjs/components/prism-bash.min.js"></script>\n'
'<script src="https://cdn.jsdelivr.net/npm/sweetalert2@11"></script>\n'
"<script>if(matchMedia('(hover:hover) and (pointer:fine)').matches){document.documentElement.classList.add('hover-capable')}</script>\n" "<script>if(matchMedia('(hover:hover) and (pointer:fine)').matches){document.documentElement.classList.add('hover-capable')}</script>\n"
"<script>document.addEventListener('click',function(e){var t=e.target.closest('[data-close-details]');if(!t)return;var d=t.closest('details');if(d)d.removeAttribute('open')})</script>\n" "<script>document.addEventListener('click',function(e){var t=e.target.closest('[data-close-details]');if(!t)return;var d=t.closest('details');if(d)d.removeAttribute('open')})</script>\n"
'<style>\n' '<style>\n'
@@ -1084,11 +1073,8 @@ def sx_page_streaming_parts(ctx: dict, page_html: str, *,
# Tail: bootstrap suspense resolver + scripts + close # Tail: bootstrap suspense resolver + scripts + close
tail = ( tail = (
_SX_STREAMING_BOOTSTRAP + '\n' _SX_STREAMING_BOOTSTRAP + '\n'
+ (f'<script src="{asset_url}/wasm/sx_browser.bc.wasm.js"></script>\n' + f'<script src="{asset_url}/wasm/sx_browser.bc.wasm.js?v={wasm_hash}"></script>\n'
f'<script src="{asset_url}/wasm/sx-platform.js"></script>\n' f'<script src="{asset_url}/wasm/sx-platform.js?v={wasm_hash}"></script>\n'
if os.environ.get("SX_USE_WASM") == "1" else
f'<script src="{asset_url}/scripts/sx-browser.js?v={sx_js_hash}"></script>\n')
+ f'<script src="{asset_url}/scripts/body.js?v={body_js_hash}"></script>\n'
) )
return shell, tail return shell, tail

143
shared/sx/templates/shell.sx
View File

@@ -1,29 +1,25 @@
;; --------------------------------------------------------------------------- (defcomp
;; Page shell — the outermost HTML document structure ~shared:shell/sx-page-shell
;; (&key
;; Replaces the Python HTML string template. All page data is computed in (title :as string)
;; Python and passed as keyword arguments. The component just arranges (meta-html :as string?)
;; the precomputed values into HTML structure. (csrf :as string)
;; (sx-css :as string?)
;; raw! is used for: (sx-css-classes :as string?)
;; - <!doctype html> (not an element) (component-hash :as string?)
;; - Script/style content (must not be HTML-escaped) (component-defs :as string?)
;; - Pre-rendered meta HTML from callers (pages-sx :as string?)
;; --------------------------------------------------------------------------- (page-sx :as string?)
(body-html :as string?)
(defcomp ~shared:shell/sx-page-shell (&key (title :as string) (meta-html :as string?) (csrf :as string) (asset-url :as string)
(sx-css :as string?) (sx-css-classes :as string?) (wasm-hash :as string?)
(component-hash :as string?) (component-defs :as string?) (inline-css :as string?)
(pages-sx :as string?) (page-sx :as string?) (inline-head-js :as string?)
(body-html :as string?) (init-sx :as string?))
(asset-url :as string) (sx-js-hash :as string) (body-js-hash :as string?)
(wasm-hash :as string?)
(head-scripts :as list?) (inline-css :as string?) (inline-head-js :as string?)
(init-sx :as string?) (body-scripts :as list?)
(use-wasm :as boolean?))
(<> (<>
(raw! "<!doctype html>") (raw! "<!doctype html>")
(html :lang "en" (html
:lang "en"
(head (head
(meta :charset "utf-8") (meta :charset "utf-8")
(meta :name "viewport" :content "width=device-width, initial-scale=1") (meta :name "viewport" :content "width=device-width, initial-scale=1")
@@ -33,70 +29,53 @@
(when meta-html (raw! meta-html)) (when meta-html (raw! meta-html))
(meta :name "csrf-token" :content csrf) (meta :name "csrf-token" :content csrf)
(style :id "sx-css" (raw! (or sx-css ""))) (style :id "sx-css" (raw! (or sx-css "")))
;; CSSX rules from island SSR — must be in <head> so they survive (let
;; #main-panel morphs during SPA navigation. ((cssx-rules (collected "cssx")))
(let ((cssx-rules (collected "cssx")))
(clear-collected! "cssx") (clear-collected! "cssx")
(when (not (empty? cssx-rules)) (when
(not (empty? cssx-rules))
(style :data-cssx true (raw! (join "" cssx-rules))))) (style :data-cssx true (raw! (join "" cssx-rules)))))
(meta :name "sx-css-classes" :content (or sx-css-classes "")) (meta :name "sx-css-classes" :content (or sx-css-classes ""))
;; CDN / head scripts — configurable per app (if
;; Pass a list (even empty) to override defaults; nil = use defaults (not (nil? inline-head-js))
(if (not (nil? head-scripts)) (when
(map (fn (src) (script :src src)) head-scripts) (not (empty? inline-head-js))
;; Default: Prism + SweetAlert (legacy apps) (script (raw! inline-head-js)))
(<> (<>
(script :src "https://unpkg.com/prismjs/prism.js") (script
(script :src "https://unpkg.com/prismjs/components/prism-javascript.min.js") (raw!
(script :src "https://unpkg.com/prismjs/components/prism-python.min.js") "if(matchMedia('(hover:hover) and (pointer:fine)').matches){document.documentElement.classList.add('hover-capable')}"))
(script :src "https://unpkg.com/prismjs/components/prism-bash.min.js") (script
(script :src "https://cdn.jsdelivr.net/npm/sweetalert2@11"))) (raw!
;; Inline JS — skipped when app provides its own inline-head-js (even empty) "document.addEventListener('click',function(e){var t=e.target.closest('[data-close-details]');if(!t)return;var d=t.closest('details');if(d)d.removeAttribute('open')})"))))
(if (not (nil? inline-head-js)) (if
(when (not (empty? inline-head-js)) (script (raw! inline-head-js))) (not (nil? inline-css))
(<>
(script (raw! "if(matchMedia('(hover:hover) and (pointer:fine)').matches){document.documentElement.classList.add('hover-capable')}"))
(script (raw! "document.addEventListener('click',function(e){var t=e.target.closest('[data-close-details]');if(!t)return;var d=t.closest('details');if(d)d.removeAttribute('open')})"))))
;; Inline CSS — configurable per app
;; Pass a string (even empty) to override defaults; nil = use defaults
(if (not (nil? inline-css))
(style (raw! inline-css)) (style (raw! inline-css))
;; Default: all shared styles (legacy apps) (style
(style (raw! "details[data-toggle-group=\"mobile-panels\"]>summary{list-style:none} (raw!
details[data-toggle-group=\"mobile-panels\"]>summary::-webkit-details-marker{display:none} "details[data-toggle-group=\"mobile-panels\"]>summary{list-style:none}\ndetails[data-toggle-group=\"mobile-panels\"]>summary::-webkit-details-marker{display:none}\n@media(min-width:768px){.nav-group:focus-within .submenu,.nav-group:hover .submenu{display:block}}\nimg{max-width:100%;height:auto}\n.clamp-2{display:-webkit-box;-webkit-line-clamp:2;-webkit-box-orient:vertical;overflow:hidden}\n.clamp-3{display:-webkit-box;-webkit-line-clamp:3;-webkit-box-orient:vertical;overflow:hidden}\n.no-scrollbar::-webkit-scrollbar{display:none}.no-scrollbar{-ms-overflow-style:none;scrollbar-width:none}\ndetails.group{overflow:hidden}details.group>summary{list-style:none}details.group>summary::-webkit-details-marker{display:none}\n.sx-indicator{display:none}.sx-request .sx-indicator{display:inline-flex}\n.sx-error .sx-indicator{display:none}.sx-loading .sx-indicator{display:inline-flex}\n.js-wrap.open .js-pop{display:block}.js-wrap.open .js-backdrop{display:block}"))))
@media(min-width:768px){.nav-group:focus-within .submenu,.nav-group:hover .submenu{display:block}} (body
img{max-width:100%;height:auto} :class "bg-stone-50 text-stone-900"
.clamp-2{display:-webkit-box;-webkit-line-clamp:2;-webkit-box-orient:vertical;overflow:hidden}
.clamp-3{display:-webkit-box;-webkit-line-clamp:3;-webkit-box-orient:vertical;overflow:hidden}
.no-scrollbar::-webkit-scrollbar{display:none}.no-scrollbar{-ms-overflow-style:none;scrollbar-width:none}
details.group{overflow:hidden}details.group>summary{list-style:none}details.group>summary::-webkit-details-marker{display:none}
.sx-indicator{display:none}.sx-request .sx-indicator{display:inline-flex}
.sx-error .sx-indicator{display:none}.sx-loading .sx-indicator{display:inline-flex}
.js-wrap.open .js-pop{display:block}.js-wrap.open .js-backdrop{display:block}"))))
(body :class "bg-stone-50 text-stone-900"
;; Server-rendered HTML — visible immediately before JS loads
(div :id "sx-root" (raw! (or body-html ""))) (div :id "sx-root" (raw! (or body-html "")))
(div :id "portal-root") (div :id "portal-root")
;; Island interactive elements — cursor pointer from SSR, no JS needed (style
(style (raw! "[data-sx-island] button,[data-sx-island] a,[data-sx-island] [role=button]{cursor:pointer}")) (raw!
(script :type "text/sx" :data-components true :data-hash component-hash "[data-sx-island] button,[data-sx-island] a,[data-sx-island] [role=button]{cursor:pointer}"))
(script
:type "text/sx"
:data-components true
:data-hash component-hash
(raw! (or component-defs ""))) (raw! (or component-defs "")))
(when init-sx (when
(script :type "text/sx" :data-init true init-sx
(raw! init-sx))) (script :type "text/sx" :data-init true (raw! init-sx)))
(script :type "text/sx-pages" (script :type "text/sx-pages" (raw! (or pages-sx "")))
(raw! (or pages-sx ""))) (script
(script :type "text/sx" :data-mount "#sx-root" :type "text/sx"
:data-mount "#sx-root"
(raw! (or page-sx ""))) (raw! (or page-sx "")))
(if use-wasm (let
(let ((wv (or wasm-hash "dev"))) ((wv (or wasm-hash "0")))
(<> (<>
(script :src (str asset-url "/wasm/sx_browser.bc.wasm.js?v=" wv)) (script :src (str asset-url "/wasm/sx_browser.bc.wasm.js?v=" wv))
(script :src (str asset-url "/wasm/sx-platform.js?v=" wv)))) (script :src (str asset-url "/wasm/sx-platform.js?v=" wv))))))))
(script :src (str asset-url "/scripts/sx-browser.js?v=" sx-js-hash)))
;; Body scripts — configurable per app
;; Pass a list (even empty) to override defaults; nil = use defaults
(if (not (nil? body-scripts))
(map (fn (src) (script :src src)) body-scripts)
;; Default: body.js (legacy apps)
(script :src (str asset-url "/scripts/body.js?v=" body-js-hash)))))))

31
sx/sx/page-functions.sx
View File

@@ -24,7 +24,7 @@
(content) (content)
(if (nil? content) (quote (~docs-content/home-content)) content))) (if (nil? content) (quote (~docs-content/home-content)) content)))
(define language (fn (content) (if (nil? content) nil content))) (define language (fn (content) (if (nil? content) (quote (<>)) content)))
(define (define
geography geography
@@ -32,9 +32,11 @@
(content) (content)
(if (nil? content) (quote (~geography/index-content)) content))) (if (nil? content) (quote (~geography/index-content)) content)))
(define applications (fn (content) (if (nil? content) nil content))) (define
applications
(fn (content) (if (nil? content) (quote (<>)) content)))
(define etc (fn (content) (if (nil? content) nil content))) (define etc (fn (content) (if (nil? content) (quote (<>)) content)))
(define hypermedia (fn (content) (if (nil? content) nil content))) (define hypermedia (fn (content) (if (nil? content) nil content)))
@@ -668,11 +670,24 @@
"/plan-" "/plan-"
"-content")) "-content"))
(define capabilities (fn (&key title &rest args) (quasiquote (~geography/capabilities-content)))) (define
capabilities
(fn
(&key title &rest args)
(quasiquote (~geography/capabilities-content))))
(define modules (fn (&key title &rest args) (quasiquote (~geography/modules-content)))) (define
modules
(fn (&key title &rest args) (quasiquote (~geography/modules-content))))
(define eval-rules (fn (&key title &rest args) (quasiquote (~geography/eval-rules-content)))) (define
eval-rules
(fn (&key title &rest args) (quasiquote (~geography/eval-rules-content))))
(define
(define sxtp (make-page-fn "~applications/sxtp/content" "~applications/sxtp/" nil "-content")) sxtp
(make-page-fn
"~applications/sxtp/content"
"~applications/sxtp/"
nil
"-content"))

45
web/request-handler.sx
View File

@@ -43,7 +43,7 @@
(define (define
sx-handle-request sx-handle-request
(fn (fn
(path headers env) (path headers env shell-vars)
(let (let
((is-ajax (or (has-key? headers "sx-request") (has-key? headers "hx-request"))) ((is-ajax (or (has-key? headers "sx-request") (has-key? headers "hx-request")))
(path-expr (sx-url-to-expr path)) (path-expr (sx-url-to-expr path))
@@ -52,44 +52,5 @@
(nil? page-ast) (nil? page-ast)
nil nil
(let (let
((nav-path (if (starts-with? path "/sx/") path (str "/sx" path)))) ((nav-path (if (and (>= (len path) 4) (= (slice path 0 4) "/sx/")) path (str "/sx" path))))
(cek-try {:page-ast page-ast :nav-path nav-path :is-ajax is-ajax})))))
(fn
()
(if
is-ajax
(let
((content (list (make-symbol "~layouts/doc") :path nav-path page-ast)))
(render-to-html content env))
(let
((wrapped (list (make-symbol "~layouts/doc") :path nav-path page-ast))
(full-ast
(list
(make-symbol "~shared:layout/app-body")
:content wrapped))
(body-html (render-to-html full-ast env)))
(render-to-html
(list
(make-symbol "~shared:shell/sx-page-shell")
:title "SX"
:csrf ""
:page-sx (serialize full-ast)
:body-html body-html
:component-defs __shell-component-defs
:component-hash __shell-component-hash
:pages-sx __shell-pages-sx
:sx-css __shell-sx-css
:sx-css-classes __shell-sx-css-classes
:asset-url __shell-asset-url
:sx-js-hash __shell-sx-js-hash
:body-js-hash __shell-body-js-hash
:wasm-hash __shell-wasm-hash
:head-scripts __shell-head-scripts
:body-scripts __shell-body-scripts
:inline-css __shell-inline-css
:inline-head-js __shell-inline-head-js
:init-sx __shell-init-sx
:use-wasm true
:meta-html "")
env))))
(fn (err) (str "<h1>Render error</h1><pre>" err "</pre>"))))))))