From 394c86b4748ef4231536a38d336e90452aa10bfe Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 29 Mar 2026 07:45:57 +0000 Subject: [PATCH] =?UTF-8?q?sx-http:=20SX=20request=20handler=20=E2=80=94?= =?UTF-8?q?=20move=20routing=20logic=20from=20OCaml=20to=20SX?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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) --- hosts/ocaml/bin/sx_server.ml | 219 ++++++++-------------------- tests/playwright/navigation.spec.js | 24 +++ web/request-handler.sx | 103 +++++++++++++ 3 files changed, 189 insertions(+), 157 deletions(-) create mode 100644 web/request-handler.sx diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index 0c9750ce..bf2033cd 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/hosts/ocaml/bin/sx_server.ml @@ -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 "

Not Found

" 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 "

Internal Server Error

"); diff --git a/tests/playwright/navigation.spec.js b/tests/playwright/navigation.spec.js index 13f9ab23..02f5a30e 100644 --- a/tests/playwright/navigation.spec.js +++ b/tests/playwright/navigation.spec.js @@ -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 = []; diff --git a/web/request-handler.sx b/web/request-handler.sx new file mode 100644 index 00000000..0c32ce6e --- /dev/null +++ b/web/request-handler.sx @@ -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 ""))))))))