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

sx-http: SX request handler — move routing logic from OCaml to SX

Browse Source 
New web/request-handler.sx: configurable SX function (sx-handle-request)
that receives path + headers + env and returns rendered HTML.
The handler decides full page vs AJAX fragment.

OCaml server: http_render_page now just calls the SX handler.
All routing, layout selection, AJAX detection moved to SX.
Header parsing added. is_sx_request removed from OCaml.

Configurable via SX_REQUEST_HANDLER env var (default: sx-handle-request).

WIP: handler has parse errors on some URL formats. Needs debugging.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-29 07:45:57 +00:00
parent 5c8b05a66f
commit 394c86b474
3 changed files with 189 additions and 157 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -1421,6 +1421,19 @@ let test_mode () =
(* HTTP server mode (--http PORT) *)
(* ====================================================================== *)
(** Parse HTTP headers from raw request data into (key, value) list. *)
let parse_http_headers data =
let lines = String.split_on_char '\n' data in
List.filter_map (fun line ->
let line = String.trim line in
match String.index_opt line ':' with
| Some i when i > 0 ->
let key = String.lowercase_ascii (String.trim (String.sub line 0 i)) in
let value = String.trim (String.sub line (i + 1) (String.length line - i - 1)) in
Some (key, value)
| _ -> None
) (List.tl lines) (* skip request line *)
let http_response ?(status=200) ?(content_type="text/html; charset=utf-8") body =
let status_text = match status with
| 200 -> "OK" | 301 -> "Moved Permanently" | 304 -> "Not Modified"
@@ -1461,142 +1474,36 @@ 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 =
(** Render a page by calling the configured SX request handler.
The handler function receives path, headers dict, and env.
All routing, layout, and response format logic lives in SX.
The handler function name is configurable via SX_REQUEST_HANDLER env var. *)
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 handler_name = try Sys.getenv "SX_REQUEST_HANDLER"
with Not_found -> "sx-handle-request" in
try
let handler = env_get env handler_name in
(* Build headers dict for SX *)
let headers_dict = Hashtbl.create 8 in
List.iter (fun (k, v) -> Hashtbl.replace headers_dict k (String v)) headers;
let result = Sx_ref.cek_call handler
(List [String path; Dict headers_dict; Env env]) 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 ->
Printf.eprintf "[http-ssr] failed for %s: %s\n%!" path (Printexc.to_string e); ""
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 result with
| Nil -> Printf.eprintf "[sx-http] %s → nil (%.3fs)\n%!" path (t1 -. t0); None
| String s | RawHTML s ->
Printf.eprintf "[sx-http] %s → %d bytes (%.3fs)\n%!" path (String.length s) (t1 -. t0);
Some s
| _ ->
let s = Sx_runtime.value_to_str result in
Printf.eprintf "[sx-http] %s → %d bytes (%.3fs)\n%!" path (String.length s) (t1 -. t0);
Some s)
with
| Eval_error msg ->
Printf.eprintf "[sx-http] %s handler error: %s\n%!" path msg; None
| Not_found ->
Printf.eprintf "[sx-http] handler '%s' not found in env\n%!" handler_name; None
(* ====================================================================== *)
(* Static file serving + file hashing *)
@@ -1924,6 +1831,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 *)
@@ -2028,7 +1936,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;
@@ -2063,18 +1971,6 @@ let http_mode port =
(try Unix.close client with _ -> ())
in
(* Check if request has SX-Request or HX-Request header (AJAX navigation) *)
let is_sx_request data =
let lower = String.lowercase_ascii data in
let has_substring s sub =
let slen = String.length s and sublen = String.length sub in
if sublen > slen then false
else let rec check i = if i > slen - sublen then false
else if String.sub s i sublen = sub then true else check (i + 1)
in check 0
in
has_substring lower "sx-request" || has_substring lower "hx-request"
in
(* Non-blocking event loop with render worker pool.
- Main loop: Unix.select on listen socket + all connected clients
@@ -2085,7 +1981,7 @@ let http_mode port =
let n_workers = max 2 (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
@@ -2106,13 +2002,14 @@ let http_mode port =
w
in
match work with
| Some (fd, path) ->
| Some (fd, path, headers) ->
let response =
try
match http_render_page env path with
let is_ajax = List.exists (fun (k, _) -> k = "sx-request" || k = "hx-request") headers in
match http_render_page env path headers with
| Some html ->
let resp = http_response html in
Hashtbl.replace response_cache path resp;
let resp = http_response ~content_type:"text/html; charset=utf-8" html in
if not is_ajax then Hashtbl.replace response_cache path resp;
resp
| None -> http_response ~status:404 "<h1>Not Found</h1>"
with e ->
@@ -2140,12 +2037,22 @@ 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 *)
let headers = parse_http_headers data in
let is_ajax = List.exists (fun (k, _) -> k = "sx-request" || k = "hx-request") headers in
if is_ajax then begin
(* AJAX — always render fresh via SX handler (decides format) *)
Mutex.lock render_mutex;
render_queue := !render_queue @ [(fd, path, headers)];
Condition.signal render_cond;
Mutex.unlock render_mutex;
false
end else
(* Full page — serve from cache *)
match Hashtbl.find_opt response_cache path with
| Some cached -> write_response fd cached; true
| None ->
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
@@ -2178,10 +2085,8 @@ let http_mode port =
let n = try Unix.read client buf 0 8192 with _ -> 0 in
if n > 0 then begin
let data = Bytes.sub_string buf 0 n in
let is_ajax = is_sx_request data in
if is_ajax then Printf.eprintf "[sx-http] AJAX request detected\n%!";
let handled =
try fast_handle client data is_ajax
try fast_handle client data false
with e ->
Printf.eprintf "[sx-http] Error: %s\n%!" (Printexc.to_string e);
write_response client (http_response ~status:500 "<h1>Internal Server Error</h1>");

24
tests/playwright/navigation.spec.js
View File

@@ -89,6 +89,30 @@ test.describe('Client-side Navigation', () => {
expect(headerTextAfter).toContain('sx');
});
test('navigation does not create side-by-side layout', async ({ page }) => {
await page.goto(BASE_URL + '/sx/(geography)', { waitUntil: 'networkidle' });
await page.waitForTimeout(2000);
// Navigate to Hypermedia
await page.click('a[href*="geography.(hypermedia"]:not([href*="example"])');
await page.waitForTimeout(3000);
// The header/nav should NOT be beside the content (side by side)
// Check that there's no element with the logo text at x < 300
// while content heading is at x > 300
const logo = await page.locator('[data-sx-island="layouts/header"]').boundingBox();
const heading = await page.locator('h1, h2').first().boundingBox();
if (logo && heading) {
// Both should be roughly centered, not one left and one right
const logoCenter = logo.x + logo.width / 2;
const headingCenter = heading.x + heading.width / 2;
const drift = Math.abs(logoCenter - headingCenter);
// If drift > 300px, they're side by side (broken layout)
expect(drift).toBeLessThan(300);
}
});
test('browser back button restores previous page content', async ({ page }) => {
// Collect console errors
const errors = [];

103
web/request-handler.sx Normal file
View File

@@ -0,0 +1,103 @@
(define
sx-handle-request
(fn
(path headers env)
(let
((is-ajax (or (has-key? headers "sx-request") (has-key? headers "hx-request")))
(path-expr (sx-parse-url path))
(page-ast (sx-eval-page path-expr env)))
(if
(nil? page-ast)
nil
(let
((nav-path (if (starts-with? path "/sx/") path (str "/sx" path))))
(if
is-ajax
(sx-render-ajax page-ast nav-path env)
(sx-render-full-page page-ast nav-path env)))))))
(define
sx-parse-url
(fn
(path)
(let
((p (cond (or (= path "/") (= path "/sx/") (= path "/sx")) "home" (starts-with? path "/sx/") (substring path 4 (string-length path)) (starts-with? path "/") (substring path 1 (string-length path)) :else path)))
(let ((spaced (join " " (split p ".")))) spaced))))
(define
sx-eval-page
(fn
(path-expr env)
(let
((exprs (sx-parse path-expr)))
(when
(not (empty? exprs))
(let
((expr (if (= (len exprs) 1) (first exprs) exprs))
(quoted (sx-auto-quote expr env)))
(let
((callable (if (symbol? quoted) (list quoted) quoted)))
(cek-try (fn () (eval-expr callable env)) (fn (err) nil))))))))
(define
sx-auto-quote
(fn
(expr env)
(cond
(and (symbol? expr) (not (env-has? env (symbol-name expr))))
(symbol-name expr)
(list? expr)
(map (fn (e) (sx-auto-quote e env)) expr)
:else expr)))
(define
sx-render-ajax
(fn
(page-ast nav-path env)
(let
((wrapped (list (make-symbol "~layouts/doc") :path nav-path page-ast))
(aser-result (aser (list (make-symbol "quote") wrapped) env)))
(let
((body-exprs (sx-parse aser-result)))
(let
((body-expr (if (= (len body-exprs) 1) (first body-exprs) (cons (make-symbol "<>") body-exprs))))
(render-to-html body-expr env))))))
(define
sx-render-full-page
(fn
(page-ast nav-path env)
(let
((wrapped (list (make-symbol "~layouts/doc") :path nav-path page-ast))
(full-ast
(list (make-symbol "~shared:layout/app-body") :content wrapped)))
(let
((aser-result (aser (list (make-symbol "quote") full-ast) env)))
(let
((body-exprs (sx-parse aser-result)))
(let
((body-expr (if (= (len body-exprs) 1) (first body-exprs) (cons (make-symbol "<>") body-exprs))))
(let
((body-html (render-to-html body-expr env))
(page-source (serialize full-ast)))
(~shared:shell/sx-page-shell
:title "SX"
:csrf ""
:page-sx page-source
: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 (= (or (env-get env "SX_USE_WASM") "") "1")
:meta-html ""))))))))