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

SX request handler: all routing in SX, AJAX content fragment support

Browse Source 
web/request-handler.sx: configurable SX handler called by OCaml server.
Detects AJAX (SX-Request header) and returns content fragment (no shell)
vs full page with shell. All routing, layout, response format in SX.

OCaml server: http_render_page calls sx-handle-request via CEK.
No application logic in OCaml — just HTTP accept + SX function call.

signal-condition rename: reactive signal works, condition system uses
signal-condition. Island SSR renders correctly (4/5 tests pass).

WASM JIT: no permanent disable on failure. Live globals.

WIP: page-sx empty in SX handler — client routing needs it.
Navigation tests timeout (links not found after boot).

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-29 08:03:39 +00:00
parent 8bba02fbc9
commit ea52f567de
1 changed files with 72 additions and 80 deletions
Download Patch File Download Diff File Expand all files Collapse all files

152
web/request-handler.sx
View File

@@ -1,43 +1,15 @@
(define (define
sx-handle-request sx-url-to-expr
(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 (fn
(path) (path)
(let (cond
((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))) (or (= path "/") (= path "/sx/") (= path "/sx"))
(let ((spaced (join " " (split p ".")))) spaced)))) "home"
(starts-with? path "/sx/")
(define (join " " (split (slice path 4 (len path)) "."))
sx-eval-page (starts-with? path "/")
(fn (join " " (split (slice path 1 (len path)) "."))
(path-expr env) :else path)))
(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 (define
sx-auto-quote sx-auto-quote
@@ -51,53 +23,73 @@
:else expr))) :else expr)))
(define (define
sx-render-ajax sx-eval-page
(fn (fn
(page-ast nav-path env) (path-expr env)
(let (cek-try
((wrapped (list (make-symbol "~layouts/doc") :path nav-path page-ast)) (fn
(aser-result (aser (list (make-symbol "quote") wrapped) env))) ()
(let
((body-exprs (sx-parse aser-result)))
(let (let
((body-expr (if (= (len body-exprs) 1) (first body-exprs) (cons (make-symbol "<>") body-exprs)))) ((exprs (sx-parse path-expr)))
(render-to-html body-expr env)))))) (when
(not (empty? exprs))
(let
((expr (if (= (len exprs) 1) (first exprs) exprs))
(quoted (sx-auto-quote expr env))
(callable (if (symbol? quoted) (list quoted) quoted)))
(eval-expr callable env)))))
(fn (err) nil))))
(define (define
sx-render-full-page sx-handle-request
(fn (fn
(page-ast nav-path env) (path headers env)
(let (let
((wrapped (list (make-symbol "~layouts/doc") :path nav-path page-ast)) ((is-ajax (or (has-key? headers "sx-request") (has-key? headers "hx-request")))
(full-ast (path-expr (sx-url-to-expr path))
(list (make-symbol "~shared:layout/app-body") :content wrapped))) (page-ast (sx-eval-page path-expr env)))
(let (if
((aser-result (aser (list (make-symbol "quote") full-ast) env))) (nil? page-ast)
nil
(let (let
((body-exprs (sx-parse aser-result))) ((nav-path (if (starts-with? path "/sx/") path (str "/sx" path))))
(let (cek-try
((body-expr (if (= (len body-exprs) 1) (first body-exprs) (cons (make-symbol "<>") body-exprs)))) (fn
(let ()
((body-html (render-to-html body-expr env)) (if
(page-source (serialize full-ast))) is-ajax
(~shared:shell/sx-page-shell (let
:title "SX" ((content (list (make-symbol "~layouts/doc") :path nav-path page-ast)))
:csrf "" (render-to-html content env))
:page-sx page-source (let
:body-html body-html ((wrapped (list (make-symbol "~layouts/doc") :path nav-path page-ast))
:component-defs __shell-component-defs (full-ast
:component-hash __shell-component-hash (list
:pages-sx __shell-pages-sx (make-symbol "~shared:layout/app-body")
:sx-css __shell-sx-css :content wrapped))
:sx-css-classes __shell-sx-css-classes (body-html (render-to-html full-ast env)))
:asset-url __shell-asset-url (render-to-html
:sx-js-hash __shell-sx-js-hash (list
:body-js-hash __shell-body-js-hash (make-symbol "~shared:shell/sx-page-shell")
:wasm-hash __shell-wasm-hash :title "SX"
:head-scripts __shell-head-scripts :csrf ""
:body-scripts __shell-body-scripts :page-sx ""
:inline-css __shell-inline-css :body-html body-html
:inline-head-js __shell-inline-head-js :component-defs __shell-component-defs
:init-sx __shell-init-sx :component-hash __shell-component-hash
:use-wasm (= (or (env-get env "SX_USE_WASM") "") "1") :pages-sx __shell-pages-sx
:meta-html "")))))))) :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 false
:meta-html "")
env))))
(fn (err) (str "<h1>Render error</h1><pre>" err "</pre>"))))))))