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

host: SPA fragments are SX wire format (text/sx), rendered client-side by the WASM kernel
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
Details

Browse Source 
Boosted (SPA) requests now return the SX source of the content (serialize) with
content-type text/sx, so the engine's handle-sx-response parses + sx-renders it
client-side on the WASM OCaml kernel — instead of server-rendered HTML. Direct /
no-JS requests still get the full HTML shell (SEO + first paint).

- host/blog--page: fragment branch serializes the body tree to SX wire format
  (was render-page -> HTML); full branch unchanged (HTML shell).
- host/blog--resp: new content-type-aware wrapper (text/sx for boosted, text/html
  otherwise); replaced the 13 dream-html/dream-html-status call-site wrappers.
- listings built with (cons (quote ul) items) not (list (quote ul) items): the
  list form nests children as one list and relied on render-to-html flattening
  it; sx-render (client) treats (li ...) as a call -> 'Not callable'. cons splices
  them into canonical (ul li1 li2 ...) that renders identically on both sides.

Verified: native host conformance 271/271; SX-Request returns text/sx SX source,
direct request text/html; lib/host/playwright/spa-check 4/4 (boot, boost, SX
fragment swap, back button) in chromium.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
giles
2026-06-29 13:03:48 +00:00
parent 059897970e
commit 41f3e9b276
1 changed files with 35 additions and 21 deletions
Download Patch File Download Diff File Expand all files Collapse all files

56
lib/host/blog.sx
View File

@@ -416,9 +416,12 @@
(define host/blog--page (define host/blog--page
(fn (req title body) (fn (req title body)
(if (host/blog--spa-req? req) (if (host/blog--spa-req? req)
;; fragment: inner content only — engine swaps it into #content ;; SPA fragment: SX WIRE FORMAT (text/sx), not HTML. The WASM kernel parses
(render-page body) ;; + renders it client-side into #content (the engine's handle-sx-response).
;; full SPA shell: WASM kernel + platform + boosted #content ;; No server-side HTML render on the boosted path.
(serialize body)
;; full SPA shell: WASM kernel + platform + boosted #content (server HTML
;; for first load / no-JS / SEO)
(str "<!doctype html>" (str "<!doctype html>"
(render-page (render-page
(quasiquote (quasiquote
@@ -434,6 +437,17 @@
(div :sx-boost "#content" (div :sx-boost "#content"
(div :id "content" (unquote body))))))))))) (div :id "content" (unquote body)))))))))))
;; Wrap a host/blog--page result in a response with the matching content-type:
;; text/sx for a boosted (SPA) request (the WASM kernel renders it), text/html
;; for a full-page request. Replaces the old dream-html/-status wrappers so the
;; boosted path ships SX instead of server-rendered HTML.
(define host/blog--resp
(fn (req status str)
(dream-response status
{:content-type
(if (host/blog--spa-req? req) "text/sx; charset=utf-8" "text/html; charset=utf-8")}
str)))
;; ── registry-driven relation rendering (post page) ────────────────── ;; ── registry-driven relation rendering (post page) ──────────────────
;; One labelled block of links from records ({:slug :title}), or "" when empty. ;; One labelled block of links from records ({:slug :title}), or "" when empty.
;; Records are pre-fetched, so the tree is built from in-memory data only. ;; Records are pre-fetched, so the tree is built from in-memory data only.
@@ -448,7 +462,7 @@
(quasiquote (quasiquote
(div :style "margin-top:2em" (div :style "margin-top:2em"
(h3 (unquote label)) (h3 (unquote label))
(unquote (list (quote ul) items))))) (unquote (cons (quote ul) items)))))
""))) "")))
;; nodes -> {:slug :title} records, existence-filtered against a shared key set. ;; nodes -> {:slug :title} records, existence-filtered against a shared key set.
@@ -536,7 +550,7 @@
(h3 (unquote (get spec :label))) (h3 (unquote (get spec :label)))
(unquote (unquote
(if (> (len current) 0) (if (> (len current) 0)
(list (quote ul) (cons (quote ul)
(map (fn (s) (map (fn (s)
(quasiquote (quasiquote
(li (a :href (unquote (str "/" s "/")) (unquote s)) " " (li (a :href (unquote (str "/" s "/")) (unquote s)) " "
@@ -596,7 +610,7 @@
;; come from iterating the registry — one section, registry-driven. ;; come from iterating the registry — one section, registry-driven.
(relations (host/blog--relations-or-hint slug (not (nil? principal)))) (relations (host/blog--relations-or-hint slug (not (nil? principal))))
(auth-foot (host/auth-footer req))) (auth-foot (host/auth-footer req)))
(dream-html (host/blog--resp req 200
(host/blog--page req (get r :title) (host/blog--page req (get r :title)
(quasiquote (quasiquote
(div (div
@@ -610,7 +624,7 @@
(a :href "/" "all posts") (a :href "/" "all posts")
" · " " · "
(unquote auth-foot)))))))) (unquote auth-foot))))))))
(dream-html-status 404 (host/blog--resp req 404
(host/blog--page req "Not found" (host/blog--page req "Not found"
(quasiquote (quasiquote
(div (h1 "404") (div (h1 "404")
@@ -627,12 +641,12 @@
(unquote (get p :title)))))) (unquote (get p :title))))))
posts))) posts)))
(let ((listing (if (> (len posts) 0) (let ((listing (if (> (len posts) 0)
(list (quote ul) items) (cons (quote ul) items)
(quote (p "No posts yet.")))) (quote (p "No posts yet."))))
;; auth-footer does a durable session read — bind it BEFORE the ;; auth-footer does a durable session read — bind it BEFORE the
;; quasiquote (a perform during tree-build raises VmSuspended). ;; quasiquote (a perform during tree-build raises VmSuspended).
(auth-foot (host/auth-footer req))) (auth-foot (host/auth-footer req)))
(dream-html (host/blog--resp req 200
(host/blog--page req "Blog" (host/blog--page req "Blog"
(quasiquote (quasiquote
(div (h1 "Posts") (div (h1 "Posts")
@@ -657,12 +671,12 @@
(li (a :href (unquote (str "/" (get p :slug) "/")) (li (a :href (unquote (str "/" (get p :slug) "/"))
(unquote (get p :title)))))) (unquote (get p :title))))))
recs))) recs)))
(dream-html (host/blog--resp req 200
(host/blog--page req "Tags" (host/blog--page req "Tags"
(quasiquote (quasiquote
(div (h1 "Tags") (div (h1 "Tags")
(unquote (if (> (len recs) 0) (unquote (if (> (len recs) 0)
(list (quote ul) items) (cons (quote ul) items)
(quote (p "No tags yet.")))) (quote (p "No tags yet."))))
(p :style "margin-top:2em;font-size:0.9em;opacity:0.8" (p :style "margin-top:2em;font-size:0.9em;opacity:0.8"
(a :href "/" "all posts") " · " (unquote auth-foot)))))))))) (a :href "/" "all posts") " · " (unquote auth-foot))))))))))
@@ -677,7 +691,7 @@
(if r (if r
(dream-response 200 {:content-type "text/plain; charset=utf-8"} (dream-response 200 {:content-type "text/plain; charset=utf-8"}
(or (get r :sx-content) "")) (or (get r :sx-content) ""))
(dream-html-status 404 (host/blog--resp req 404
(host/blog--page req "Not found" (host/blog--page req "Not found"
(quasiquote (div (h1 "404") (p (unquote (str "No post: " slug)))))))))))) (quasiquote (div (h1 "404") (p (unquote (str "No post: " slug))))))))))))
@@ -686,7 +700,7 @@
;; future native SX-island editor (Phase 5.2+). Posts to /new. ;; future native SX-island editor (Phase 5.2+). Posts to /new.
(define host/blog-new-form (define host/blog-new-form
(fn (req) (fn (req)
(dream-html (host/blog--resp req 200
(host/blog--page req "New post" (host/blog--page req "New post"
(quasiquote (quasiquote
(div (div
@@ -726,12 +740,12 @@
(status (or (dream-form-field req "status") "published"))) (status (or (dream-form-field req "status") "published")))
(cond (cond
((or (nil? title) (= title "")) ((or (nil? title) (= title ""))
(dream-html-status 400 (host/blog--resp req 400
(host/blog--page req "Error" (host/blog--page req "Error"
(quasiquote (div (h1 "Error") (p "Title is required.") (quasiquote (div (h1 "Error") (p "Title is required.")
(p (a :href "/new" "Back"))))))) (p (a :href "/new" "Back")))))))
((not (host/blog-content-ok? sx-content)) ((not (host/blog-content-ok? sx-content))
(dream-html-status 400 (host/blog--resp req 400
(host/blog--page req "Error" (host/blog--page req "Error"
(quasiquote (div (h1 "Error") (p "Post body is not valid SX markup.") (quasiquote (div (h1 "Error") (p "Post body is not valid SX markup.")
(p (a :href "/new" "Back"))))))) (p (a :href "/new" "Back")))))))
@@ -813,7 +827,7 @@
(other (dream-form-field req "other")) (other (dream-form-field req "other"))
(kind (or (dream-form-field req "kind") "related"))) (kind (or (dream-form-field req "kind") "related")))
(if (nil? (host/blog-get slug)) (if (nil? (host/blog-get slug))
(dream-html-status 404 (host/blog--resp req 404
(host/blog--page req "Not found" (host/blog--page req "Not found"
(quasiquote (div (h1 "404") (p (unquote (str "No post: " slug))))))) (quasiquote (div (h1 "404") (p (unquote (str "No post: " slug)))))))
(begin (begin
@@ -843,7 +857,7 @@
(let ((slug (dream-param req "slug"))) (let ((slug (dream-param req "slug")))
(let ((r (host/blog-get slug))) (let ((r (host/blog-get slug)))
(if (nil? r) (if (nil? r)
(dream-html-status 404 (host/blog--resp req 404
(host/blog--page req "Not found" (host/blog--page req "Not found"
(quasiquote (div (h1 "404") (p (unquote (str "No post: " slug))))))) (quasiquote (div (h1 "404") (p (unquote (str "No post: " slug)))))))
(let ((status (get r :status))) (let ((status (get r :status)))
@@ -856,7 +870,7 @@
(if (= val status) (if (= val status)
(quasiquote (option :value (unquote val) :selected "selected" (unquote label))) (quasiquote (option :value (unquote val) :selected "selected" (unquote label)))
(quasiquote (option :value (unquote val) (unquote label))))))) (quasiquote (option :value (unquote val) (unquote label)))))))
(dream-html (host/blog--resp req 200
(host/blog--page req (str "Edit: " (get r :title)) (host/blog--page req (str "Edit: " (get r :title))
(quasiquote (quasiquote
(div (div
@@ -888,7 +902,7 @@
(fn (req) (fn (req)
(let ((slug (dream-param req "slug")) (r (host/blog-get (dream-param req "slug")))) (let ((slug (dream-param req "slug")) (r (host/blog-get (dream-param req "slug"))))
(if (nil? r) (if (nil? r)
(dream-html-status 404 (host/blog--resp req 404
(host/blog--page req "Not found" (host/blog--page req "Not found"
(quasiquote (div (h1 "404") (p (unquote (str "No post: " slug))))))) (quasiquote (div (h1 "404") (p (unquote (str "No post: " slug)))))))
(let ((title (or (dream-form-field req "title") (get r :title))) (let ((title (or (dream-form-field req "title") (get r :title)))
@@ -904,12 +918,12 @@
(host/blog-put! slug title sx-content status) (host/blog-put! slug title sx-content status)
(dream-redirect (str "/" slug "/"))) (dream-redirect (str "/" slug "/")))
(let ((issue-items (map (fn (i) (quasiquote (li (unquote i)))) issues))) (let ((issue-items (map (fn (i) (quasiquote (li (unquote i)))) issues)))
(dream-html-status 400 (host/blog--resp req 400
(host/blog--page req "Cannot save" (host/blog--page req "Cannot save"
(quasiquote (quasiquote
(div (h1 "Cannot save") (div (h1 "Cannot save")
(p "This post can't be saved yet:") (p "This post can't be saved yet:")
(unquote (list (quote ul) issue-items)) (unquote (cons (quote ul) issue-items))
(p (a :href (unquote (str "/" slug "/edit")) "Back")))))))))))))) (p (a :href (unquote (str "/" slug "/edit")) "Back"))))))))))))))
;; ── routes ────────────────────────────────────────────────────────── ;; ── routes ──────────────────────────────────────────────────────────