SX request handler + AJAX nav + shared JIT globals + shell cleanup
- 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:
@@ -569,6 +569,15 @@ let setup_type_constructors env =
|
||||
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))))
|
||||
| _ -> 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 ->
|
||||
match args with
|
||||
| [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 *)
|
||||
let env_to_vm_globals env =
|
||||
let g = Hashtbl.create (Hashtbl.length env.Sx_types.bindings) in
|
||||
Hashtbl.iter (fun id v -> Hashtbl.replace g (Sx_types.unintern id) v) env.Sx_types.bindings;
|
||||
g
|
||||
(* Shared VM globals table — one live table, all JIT closures share
|
||||
the same reference. Kept in sync via env_bind hook so late-bound
|
||||
values (shell statics, page functions, defines) are always visible. *)
|
||||
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 env = make_env () in
|
||||
@@ -1462,142 +1480,123 @@ let url_decode s =
|
||||
done;
|
||||
Buffer.contents buf
|
||||
|
||||
(** Render a page from an SX URL path. Returns HTML or None. *)
|
||||
let http_render_page env path =
|
||||
let parse_http_headers data =
|
||||
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
|
||||
(* Parse the URL path to an SX expression *)
|
||||
let path_expr =
|
||||
if path = "/" || path = "/sx/" || path = "/sx" then "home"
|
||||
else begin
|
||||
let p = if String.length path > 4 && String.sub path 0 4 = "/sx/" then
|
||||
String.sub path 4 (String.length path - 4)
|
||||
else if String.length path > 1 && path.[0] = '/' then
|
||||
String.sub path 1 (String.length path - 1)
|
||||
else path
|
||||
in
|
||||
(* URL convention: dots → spaces *)
|
||||
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
|
||||
(* Phase 0: Route via SX handler — returns {:is-ajax :nav-path :page-ast} *)
|
||||
let handler = try env_get env "sx-handle-request" with _ -> Nil in
|
||||
if handler = Nil then (Printf.eprintf "[http] sx-handle-request not found\n%!"; None)
|
||||
else
|
||||
let headers_dict = Hashtbl.create 8 in
|
||||
List.iter (fun (k, v) ->
|
||||
Hashtbl.replace headers_dict (String.lowercase_ascii k) (String v)
|
||||
) headers;
|
||||
let route_result =
|
||||
try Sx_ref.cek_call handler
|
||||
(List [String path; Dict headers_dict; Env env; Nil])
|
||||
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
|
||||
let t3 = Unix.gettimeofday () in
|
||||
(* Phase 3: Shell — render directly to buffer for zero-copy output *)
|
||||
let get_shell_var 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_var "component-defs";
|
||||
Keyword "component-hash"; get_shell_var "component-hash";
|
||||
Keyword "pages-sx"; get_shell_var "pages-sx";
|
||||
Keyword "sx-css"; get_shell_var "sx-css";
|
||||
Keyword "sx-css-classes"; get_shell_var "sx-css-classes";
|
||||
Keyword "asset-url"; get_shell_var "asset-url";
|
||||
Keyword "sx-js-hash"; get_shell_var "sx-js-hash";
|
||||
Keyword "body-js-hash"; get_shell_var "body-js-hash";
|
||||
Keyword "wasm-hash"; get_shell_var "wasm-hash";
|
||||
Keyword "head-scripts"; get_shell_var "head-scripts";
|
||||
Keyword "body-scripts"; get_shell_var "body-scripts";
|
||||
Keyword "inline-css"; get_shell_var "inline-css";
|
||||
Keyword "inline-head-js"; get_shell_var "inline-head-js";
|
||||
Keyword "init-sx"; get_shell_var "init-sx";
|
||||
Keyword "use-wasm"; Bool (try Sys.getenv "SX_USE_WASM" = "1" with Not_found -> false);
|
||||
Keyword "meta-html"; String "";
|
||||
] in
|
||||
let shell_call = List (Symbol "~shared:shell/sx-page-shell" :: shell_args) in
|
||||
(* Use SX adapter for shell too — it's an SX component *)
|
||||
let html =
|
||||
if env_has env "render-to-html" then begin
|
||||
let render_call = List [Symbol "render-to-html";
|
||||
List [Symbol "quote"; shell_call];
|
||||
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
|
||||
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
|
||||
match route_result with
|
||||
| Nil -> None
|
||||
| Dict d ->
|
||||
let is_ajax = match Hashtbl.find_opt d "is-ajax" with Some (Bool true) -> true | _ -> false in
|
||||
let nav_path = match Hashtbl.find_opt d "nav-path" with Some (String s) -> s | _ -> path in
|
||||
let page_ast = match Hashtbl.find_opt d "page-ast" with Some v -> v | _ -> Nil in
|
||||
if page_ast = Nil then None
|
||||
else begin
|
||||
let wrapped = List [Symbol "~layouts/doc"; Keyword "path"; String nav_path; page_ast] in
|
||||
if is_ajax then begin
|
||||
(* AJAX: render content fragment only — no shell *)
|
||||
let body_result =
|
||||
let call = List [Symbol "aser"; List [Symbol "quote"; wrapped]; 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 body_html = try
|
||||
let body_expr = match Sx_parser.parse_all body_str with
|
||||
| [e] -> e | [] -> Nil | es -> List (Symbol "<>" :: es) in
|
||||
let render_call = List [Symbol "render-to-html";
|
||||
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)
|
||||
with e -> Printf.eprintf "[http-ajax] ssr error: %s\n%!" (Printexc.to_string e); "" in
|
||||
let t1 = Unix.gettimeofday () in
|
||||
Printf.eprintf "[sx-http] %s AJAX %.3fs html=%d\n%!" path (t1 -. t0) (String.length body_html);
|
||||
Some body_html
|
||||
end else begin
|
||||
(* Full page: aser → SSR → shell *)
|
||||
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
|
||||
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
|
||||
let body_html = try
|
||||
let body_expr = match Sx_parser.parse_all body_str with
|
||||
| [e] -> e | [] -> Nil | es -> List (Symbol "<>" :: es) in
|
||||
if env_has env "render-to-html" then
|
||||
let render_call = List [Symbol "render-to-html";
|
||||
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 *)
|
||||
@@ -1706,8 +1705,6 @@ let http_inject_shell_statics env static_dir sx_sxc =
|
||||
let component_defs = raw_defs in
|
||||
let component_hash = Digest.string component_defs |> Digest.to_hex in
|
||||
(* 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
|
||||
(* Read CSS for inline injection *)
|
||||
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-classes" (String ""));
|
||||
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-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-head-js" Nil);
|
||||
(* 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(); \
|
||||
} \
|
||||
});"));
|
||||
Printf.eprintf "[sx-http] Shell statics: defs=%d hash=%s css=%d js=%s wasm=%s\n%!"
|
||||
(String.length component_defs) component_hash (String.length sx_css) sx_js_hash wasm_hash
|
||||
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) wasm_hash
|
||||
|
||||
let http_setup_declarative_stubs env =
|
||||
(* Stub declarative forms that are metadata-only — no-ops at render time. *)
|
||||
@@ -1925,6 +1918,7 @@ let http_mode port =
|
||||
lib_base ^ "/compiler.sx";
|
||||
web_base ^ "/adapter-html.sx"; web_base ^ "/adapter-sx.sx";
|
||||
web_base ^ "/web-forms.sx"; web_base ^ "/engine.sx";
|
||||
web_base ^ "/request-handler.sx";
|
||||
] in
|
||||
http_load_files env core_files;
|
||||
(* Libraries *)
|
||||
@@ -1961,8 +1955,6 @@ let http_mode port =
|
||||
load_dir sx_sx;
|
||||
let t1 = Unix.gettimeofday () in
|
||||
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 count = ref 0 in
|
||||
let compiler_names = [
|
||||
@@ -2022,6 +2014,10 @@ let http_mode port =
|
||||
ignore (env_bind env "expand-components?" (NativeFn ("expand-components?", fun _args -> Bool true)));
|
||||
(* Inject shell statics with real file hashes, CSS, and pages registry *)
|
||||
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.
|
||||
Populated during pre-warm, serves cached responses in <0.1ms.
|
||||
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 cache_response path =
|
||||
match http_render_page env path with
|
||||
match http_render_page env path [] with
|
||||
| Some html ->
|
||||
let resp = http_response html in
|
||||
Hashtbl.replace response_cache path resp;
|
||||
@@ -2039,9 +2035,9 @@ let http_mode port =
|
||||
in
|
||||
|
||||
(* 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/(language)"; "/sx/(applications)";
|
||||
"/sx/(geography.(reactive))"; "/sx/(geography.(hypermedia))";
|
||||
] 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
|
||||
|
||||
(* 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_cond = Condition.create () in
|
||||
let shutdown = ref false in
|
||||
@@ -2107,13 +2103,14 @@ let http_mode port =
|
||||
w
|
||||
in
|
||||
match work with
|
||||
| Some (fd, path) ->
|
||||
| Some (fd, path, headers) ->
|
||||
let cache_key = if headers <> [] then "ajax:" ^ path else path in
|
||||
let response =
|
||||
try
|
||||
match http_render_page env path with
|
||||
match http_render_page env path headers with
|
||||
| Some html ->
|
||||
let resp = http_response html in
|
||||
Hashtbl.replace response_cache path resp;
|
||||
Hashtbl.replace response_cache cache_key resp;
|
||||
resp
|
||||
| None -> http_response ~status:404 "<h1>Not Found</h1>"
|
||||
with e ->
|
||||
@@ -2127,7 +2124,7 @@ let http_mode port =
|
||||
|
||||
(* Fast path: handle a request from the main loop.
|
||||
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
|
||||
| None -> write_response fd (http_response ~status:400 "Bad Request"); true
|
||||
| Some (method_, raw_path) ->
|
||||
@@ -2141,12 +2138,13 @@ let http_mode port =
|
||||
let is_sx = path = "/sx/" || path = "/sx"
|
||||
|| (String.length path > 4 && String.sub path 0 4 = "/sx/") in
|
||||
if is_sx then begin
|
||||
(* Serve from cache (full page) — client handles sx-select extraction *)
|
||||
match Hashtbl.find_opt response_cache path with
|
||||
let cache_key = if is_ajax then "ajax:" ^ path else path in
|
||||
match Hashtbl.find_opt response_cache cache_key with
|
||||
| Some cached -> write_response fd cached; true
|
||||
| None ->
|
||||
let headers = if is_ajax then parse_http_headers data else [] in
|
||||
Mutex.lock render_mutex;
|
||||
render_queue := !render_queue @ [(fd, path)];
|
||||
render_queue := !render_queue @ [(fd, path, headers)];
|
||||
Condition.signal render_cond;
|
||||
Mutex.unlock render_mutex;
|
||||
false
|
||||
|
||||
@@ -883,16 +883,11 @@ def _get_shell_static() -> dict[str, Any]:
|
||||
pages_sx=pages_sx,
|
||||
sx_css=sx_css,
|
||||
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"),
|
||||
asset_url=_ca.config.get("ASSET_URL", "/static"),
|
||||
head_scripts=_shell_cfg.get("head_scripts"),
|
||||
inline_css=_shell_cfg.get("inline_css"),
|
||||
inline_head_js=_shell_cfg.get("inline_head_js"),
|
||||
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()
|
||||
@@ -1037,8 +1032,7 @@ def sx_page_streaming_parts(ctx: dict, page_html: str, *,
|
||||
from quart import current_app
|
||||
pages_sx = _build_pages_sx(current_app.name)
|
||||
|
||||
sx_js_hash = _script_hash("sx-browser.js")
|
||||
body_js_hash = _script_hash("body.js")
|
||||
wasm_hash = _wasm_hash("sx_browser.bc.js")
|
||||
|
||||
# Shell: head + body with server-rendered HTML (not SX mount script)
|
||||
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'<style id="sx-css">{sx_css}</style>\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>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'
|
||||
@@ -1084,11 +1073,8 @@ def sx_page_streaming_parts(ctx: dict, page_html: str, *,
|
||||
# Tail: bootstrap suspense resolver + scripts + close
|
||||
tail = (
|
||||
_SX_STREAMING_BOOTSTRAP + '\n'
|
||||
+ (f'<script src="{asset_url}/wasm/sx_browser.bc.wasm.js"></script>\n'
|
||||
f'<script src="{asset_url}/wasm/sx-platform.js"></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'
|
||||
+ 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?v={wasm_hash}"></script>\n'
|
||||
)
|
||||
|
||||
return shell, tail
|
||||
|
||||
@@ -1,29 +1,25 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Page shell — the outermost HTML document structure
|
||||
;;
|
||||
;; Replaces the Python HTML string template. All page data is computed in
|
||||
;; Python and passed as keyword arguments. The component just arranges
|
||||
;; the precomputed values into HTML structure.
|
||||
;;
|
||||
;; raw! is used for:
|
||||
;; - <!doctype html> (not an element)
|
||||
;; - Script/style content (must not be HTML-escaped)
|
||||
;; - Pre-rendered meta HTML from callers
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~shared:shell/sx-page-shell (&key (title :as string) (meta-html :as string?) (csrf :as string)
|
||||
(sx-css :as string?) (sx-css-classes :as string?)
|
||||
(component-hash :as string?) (component-defs :as string?)
|
||||
(pages-sx :as string?) (page-sx :as string?)
|
||||
(body-html :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?))
|
||||
(defcomp
|
||||
~shared:shell/sx-page-shell
|
||||
(&key
|
||||
(title :as string)
|
||||
(meta-html :as string?)
|
||||
(csrf :as string)
|
||||
(sx-css :as string?)
|
||||
(sx-css-classes :as string?)
|
||||
(component-hash :as string?)
|
||||
(component-defs :as string?)
|
||||
(pages-sx :as string?)
|
||||
(page-sx :as string?)
|
||||
(body-html :as string?)
|
||||
(asset-url :as string)
|
||||
(wasm-hash :as string?)
|
||||
(inline-css :as string?)
|
||||
(inline-head-js :as string?)
|
||||
(init-sx :as string?))
|
||||
(<>
|
||||
(raw! "<!doctype html>")
|
||||
(html :lang "en"
|
||||
(html
|
||||
:lang "en"
|
||||
(head
|
||||
(meta :charset "utf-8")
|
||||
(meta :name "viewport" :content "width=device-width, initial-scale=1")
|
||||
@@ -33,70 +29,53 @@
|
||||
(when meta-html (raw! meta-html))
|
||||
(meta :name "csrf-token" :content csrf)
|
||||
(style :id "sx-css" (raw! (or sx-css "")))
|
||||
;; CSSX rules from island SSR — must be in <head> so they survive
|
||||
;; #main-panel morphs during SPA navigation.
|
||||
(let ((cssx-rules (collected "cssx")))
|
||||
(let
|
||||
((cssx-rules (collected "cssx")))
|
||||
(clear-collected! "cssx")
|
||||
(when (not (empty? cssx-rules))
|
||||
(when
|
||||
(not (empty? cssx-rules))
|
||||
(style :data-cssx true (raw! (join "" cssx-rules)))))
|
||||
(meta :name "sx-css-classes" :content (or sx-css-classes ""))
|
||||
;; CDN / head scripts — configurable per app
|
||||
;; Pass a list (even empty) to override defaults; nil = use defaults
|
||||
(if (not (nil? head-scripts))
|
||||
(map (fn (src) (script :src src)) head-scripts)
|
||||
;; Default: Prism + SweetAlert (legacy apps)
|
||||
(if
|
||||
(not (nil? inline-head-js))
|
||||
(when
|
||||
(not (empty? inline-head-js))
|
||||
(script (raw! inline-head-js)))
|
||||
(<>
|
||||
(script :src "https://unpkg.com/prismjs/prism.js")
|
||||
(script :src "https://unpkg.com/prismjs/components/prism-javascript.min.js")
|
||||
(script :src "https://unpkg.com/prismjs/components/prism-python.min.js")
|
||||
(script :src "https://unpkg.com/prismjs/components/prism-bash.min.js")
|
||||
(script :src "https://cdn.jsdelivr.net/npm/sweetalert2@11")))
|
||||
;; Inline JS — skipped when app provides its own inline-head-js (even empty)
|
||||
(if (not (nil? inline-head-js))
|
||||
(when (not (empty? inline-head-js)) (script (raw! inline-head-js)))
|
||||
(<>
|
||||
(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))
|
||||
(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')})"))))
|
||||
(if
|
||||
(not (nil? inline-css))
|
||||
(style (raw! inline-css))
|
||||
;; Default: all shared styles (legacy apps)
|
||||
(style (raw! "details[data-toggle-group=\"mobile-panels\"]>summary{list-style:none}
|
||||
details[data-toggle-group=\"mobile-panels\"]>summary::-webkit-details-marker{display:none}
|
||||
@media(min-width:768px){.nav-group:focus-within .submenu,.nav-group:hover .submenu{display:block}}
|
||||
img{max-width:100%;height:auto}
|
||||
.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
|
||||
(style
|
||||
(raw!
|
||||
"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}"))))
|
||||
(body
|
||||
:class "bg-stone-50 text-stone-900"
|
||||
(div :id "sx-root" (raw! (or body-html "")))
|
||||
(div :id "portal-root")
|
||||
;; Island interactive elements — cursor pointer from SSR, no JS needed
|
||||
(style (raw! "[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
|
||||
(style
|
||||
(raw!
|
||||
"[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 "")))
|
||||
(when init-sx
|
||||
(script :type "text/sx" :data-init true
|
||||
(raw! init-sx)))
|
||||
(script :type "text/sx-pages"
|
||||
(raw! (or pages-sx "")))
|
||||
(script :type "text/sx" :data-mount "#sx-root"
|
||||
(when
|
||||
init-sx
|
||||
(script :type "text/sx" :data-init true (raw! init-sx)))
|
||||
(script :type "text/sx-pages" (raw! (or pages-sx "")))
|
||||
(script
|
||||
:type "text/sx"
|
||||
:data-mount "#sx-root"
|
||||
(raw! (or page-sx "")))
|
||||
(if use-wasm
|
||||
(let ((wv (or wasm-hash "dev")))
|
||||
(<>
|
||||
(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 "/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)))))))
|
||||
(let
|
||||
((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-platform.js?v=" wv))))))))
|
||||
|
||||
@@ -24,7 +24,7 @@
|
||||
(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
|
||||
geography
|
||||
@@ -32,9 +32,11 @@
|
||||
(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)))
|
||||
|
||||
@@ -668,11 +670,24 @@
|
||||
"/plan-"
|
||||
"-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 sxtp (make-page-fn "~applications/sxtp/content" "~applications/sxtp/" nil "-content"))
|
||||
(define
|
||||
sxtp
|
||||
(make-page-fn
|
||||
"~applications/sxtp/content"
|
||||
"~applications/sxtp/"
|
||||
nil
|
||||
"-content"))
|
||||
|
||||
@@ -43,7 +43,7 @@
|
||||
(define
|
||||
sx-handle-request
|
||||
(fn
|
||||
(path headers env)
|
||||
(path headers env shell-vars)
|
||||
(let
|
||||
((is-ajax (or (has-key? headers "sx-request") (has-key? headers "hx-request")))
|
||||
(path-expr (sx-url-to-expr path))
|
||||
@@ -52,44 +52,5 @@
|
||||
(nil? page-ast)
|
||||
nil
|
||||
(let
|
||||
((nav-path (if (starts-with? path "/sx/") path (str "/sx" path))))
|
||||
(cek-try
|
||||
(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>"))))))))
|
||||
((nav-path (if (and (>= (len path) 4) (= (slice path 0 4) "/sx/")) path (str "/sx" path))))
|
||||
{:page-ast page-ast :nav-path nav-path :is-ajax is-ajax})))))
|
||||
|
||||
Reference in New Issue
Block a user