host: Phase 5.1 — interactive SX-page render from a handler, 181/181
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 21s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 21s
KERNEL: add a render-page primitive (sx_server.ml, persistent mode) that renders an UNEVALUATED SX expression with the server env via sx_render_to_html. render-to-html expands defcomp components and collects keyword attrs itself; SX handlers can't reach the server env, so the prim supplies it. Fixes the attr mangling — bare render-to-html on an EVALUATED component tree turns (form :id ..) into <form>idpost-new-form..; rendering the unevaluated expr keeps :id an attr. HOST: lib/host/page.sx — host/page (expr -> HTML response) + host/page-route (mount on a GET path). New page suite (8 tests) proves a generic attributed + nested component renders correctly through a host route; verified ~editor/form renders right too. This is the component-render step of the generic interactive-SX-page capability; shell + static assets + hydration (5.2-5.4) next. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
@@ -76,6 +76,7 @@ MODULES=(
|
||||
"lib/host/feed.sx"
|
||||
"lib/host/relations.sx"
|
||||
"lib/host/blog.sx"
|
||||
"lib/host/page.sx"
|
||||
"lib/host/server.sx"
|
||||
"lib/host/ledger.sx"
|
||||
)
|
||||
@@ -89,6 +90,7 @@ SUITES=(
|
||||
"feed host-fd-tests-run! lib/host/tests/feed.sx"
|
||||
"relations host-rl-tests-run! lib/host/tests/relations.sx"
|
||||
"blog host-bl-tests-run! lib/host/tests/blog.sx"
|
||||
"page host-pg-tests-run! lib/host/tests/page.sx"
|
||||
"server host-sv-tests-run! lib/host/tests/server.sx"
|
||||
"ledger host-lg-tests-run! lib/host/tests/ledger.sx"
|
||||
)
|
||||
|
||||
22
lib/host/page.sx
Normal file
22
lib/host/page.sx
Normal file
@@ -0,0 +1,22 @@
|
||||
;; lib/host/page.sx — serve interactive SX component/island pages on the host
|
||||
;; (Phase 5: the generic interactive-SX-page capability).
|
||||
;;
|
||||
;; The bare `render-to-html` path mangles an EVALUATED component tree's keyword
|
||||
;; attributes ((form :id ..) -> "<form>idpost-new-form..."), because evaluating a
|
||||
;; defcomp body turns `:id` into a child. The kernel `render-page` primitive
|
||||
;; instead renders an UNEVALUATED expression with the server env: render-to-html
|
||||
;; expands the components itself and collects keyword args as attributes. SX
|
||||
;; handlers can't reach the server env, so render-page supplies it.
|
||||
;;
|
||||
;; host/page wraps a rendered expression as an HTML response; host/page-route
|
||||
;; mounts it on a GET path. This is the component-render step (5.1); the full page
|
||||
;; shell (inlined component defs + CSS + client runtime + hydration) and static
|
||||
;; asset serving (5.2–5.4) build on top to make the page interactive.
|
||||
;; Depends on the kernel `render-page` primitive + lib/dream/types.sx (dream-html).
|
||||
|
||||
;; Render an unevaluated SX page/component expression to an HTML response.
|
||||
(define host/page (fn (expr) (dream-html (render-page expr))))
|
||||
|
||||
;; Mount a GET route that renders a fixed page expression.
|
||||
(define host/page-route
|
||||
(fn (path expr) (dream-get path (fn (req) (host/page expr)))))
|
||||
60
lib/host/tests/page.sx
Normal file
60
lib/host/tests/page.sx
Normal file
@@ -0,0 +1,60 @@
|
||||
;; lib/host/tests/page.sx — the host's interactive-SX-page capability (Phase 5.1).
|
||||
;; A defcomp component tree (with keyword attributes + nesting) renders to correct
|
||||
;; HTML through host/page / render-page, served by a host route. This is the
|
||||
;; capability the legacy editor (and any future island UI) needs — proven on a
|
||||
;; small component so it's not editor-specific.
|
||||
|
||||
(define host-pg-pass 0)
|
||||
(define host-pg-fail 0)
|
||||
(define host-pg-fails (list))
|
||||
(define
|
||||
host-pg-test
|
||||
(fn (name actual expected)
|
||||
(if (= actual expected)
|
||||
(set! host-pg-pass (+ host-pg-pass 1))
|
||||
(begin
|
||||
(set! host-pg-fail (+ host-pg-fail 1))
|
||||
(append! host-pg-fails {:name name :actual actual :expected expected})))))
|
||||
|
||||
;; A component with keyword attributes (the case bare render-to-html mangles) and
|
||||
;; a nested component (expansion must recurse).
|
||||
(defcomp ~pg-badge (&key (label :as string))
|
||||
(span :class "badge" :data-kind "tag" label))
|
||||
(defcomp ~pg-card (&key (title :as string))
|
||||
(div :class "card"
|
||||
(h2 :class "card-title" title)
|
||||
(~pg-badge :label "new")))
|
||||
|
||||
(define host-pg-req (fn (target) (dream-request "GET" target {} "")))
|
||||
(define host-pg-app
|
||||
(host/make-app (list (list (host/page-route "/card" (quote (~pg-card :title "Hello")))))))
|
||||
|
||||
(define host-pg-body (dream-resp-body (host-pg-app (host-pg-req "/card"))))
|
||||
|
||||
(host-pg-test "page 200"
|
||||
(dream-status (host-pg-app (host-pg-req "/card"))) 200)
|
||||
(host-pg-test "page is html"
|
||||
(contains? (dream-resp-header (host-pg-app (host-pg-req "/card")) "content-type") "text/html")
|
||||
true)
|
||||
;; attributes survive (the whole point) — class on the outer div
|
||||
(host-pg-test "outer div class attr"
|
||||
(contains? host-pg-body "class=\"card\"") true)
|
||||
;; nested component expanded + its attrs survive
|
||||
(host-pg-test "nested component expanded"
|
||||
(contains? host-pg-body "class=\"badge\"") true)
|
||||
(host-pg-test "nested data attr"
|
||||
(contains? host-pg-body "data-kind=\"tag\"") true)
|
||||
;; keyword param values rendered as text content, not attrs
|
||||
(host-pg-test "title text rendered"
|
||||
(contains? host-pg-body "Hello") true)
|
||||
(host-pg-test "badge label text rendered"
|
||||
(contains? host-pg-body ">new<") true)
|
||||
;; NOT mangled — the keyword ":class" must not leak as text content
|
||||
(host-pg-test "no mangled keyword text"
|
||||
(contains? host-pg-body ">classcard") false)
|
||||
|
||||
(define
|
||||
host-pg-tests-run!
|
||||
(fn ()
|
||||
{:total (+ host-pg-pass host-pg-fail)
|
||||
:passed host-pg-pass :failed host-pg-fail :fails host-pg-fails}))
|
||||
Reference in New Issue
Block a user