host: wire :body into live rendering — composition fold is fold #1, live (roadmap step 2)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 41s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 41s
A record may carry a :body (a composition node); host/blog-post renders it via the render-fold (host/comp-render) against a context built from the principal (auth), else the legacy sx_content path. compose.sx loaded into the host (serve.sh + conformance.sh module lists). host/blog-body-of / host/blog--set-body!. Seeded /compose-demo: ONE composition object that shows seq + alt(when auth) + row(par) + each, and renders DIFFERENTLY by context. Verified live-path (ephemeral SX_SERVING_JIT=1): anon -> login-prompt (else) + columns + event list; authed -> member block (when auth), login-prompt gone. The object is the program; the render is the execution -- now live. Focused eval confirms the in-process render matches the test (ANON<span>..> vs MEMBER<..>). Tests added; full blog suite still box-contended. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
@@ -517,6 +517,35 @@
|
||||
(fn (slug template)
|
||||
(let ((r (host/blog-get slug)))
|
||||
(when r (host/blog--write! slug (merge r {:template template}))))))
|
||||
|
||||
;; ── composition objects (plans/composition-objects.md) ──────────────
|
||||
;; A record may carry a :body — a composition node (seq/par/alt/each over object refs)
|
||||
;; rendered by the render-fold (lib/host/compose.sx) against a context. When present it
|
||||
;; supersedes :sx-content. This is fold #1; the same object renders differently per context.
|
||||
(define host/blog-body-of (fn (slug) (get (host/blog-get slug) :body)))
|
||||
(define host/blog--set-body!
|
||||
(fn (slug body)
|
||||
(let ((r (host/blog-get slug)))
|
||||
(when r (host/blog--write! slug (merge r {:body body}))))))
|
||||
;; Seed a live demo of the composition fold: one object, rendered by host/comp-render, that
|
||||
;; shows seq + alt(when auth) + row(par) + each — and renders DIFFERENTLY logged-in vs out.
|
||||
(define host/blog-seed-compose-demo!
|
||||
(fn ()
|
||||
(begin
|
||||
(host/blog-seed! "compose-demo" "Composition Demo"
|
||||
"(article (h1 \"Composition Demo\") (p \"Rendered via the composition fold.\"))" "published")
|
||||
(host/blog--set-body! "compose-demo"
|
||||
(quote (seq
|
||||
(text "<p>This whole page is <b>one composition object</b>, rendered by the fold — it renders differently depending on context.</p>")
|
||||
(alt (when (has "auth") (text "<p style=\"color:green\"><b>Members:</b> you are logged in.</p>"))
|
||||
(else (text "<p style=\"color:#999\"><i>Log in to see the member-only block.</i></p>")))
|
||||
(text "<h3>Two columns (par)</h3>")
|
||||
(row (text "<div style=\"flex:1;border:1px solid #ccc;padding:0.5em\">Column A</div>")
|
||||
(text "<div style=\"flex:1;border:1px solid #ccc;padding:0.5em\">Column B</div>"))
|
||||
(text "<h3>A list (each)</h3><ul>")
|
||||
(each (items {:name "Revel Show" :date "Aug"} {:name "Pub Night" :date "Jun"})
|
||||
(seq (text "<li>") (field :name) (text " — ") (field :date) (text "</li>")))
|
||||
(text "</ul>")))))))
|
||||
;; replace every (field "name") node in a parsed template tree with values[name] ("" if
|
||||
;; absent). Pure: a tree-walk over the already-parsed template + pre-fetched values.
|
||||
(define host/blog--instantiate
|
||||
@@ -1095,7 +1124,12 @@
|
||||
;; the quasiquote. IO must run in the handler body, never while the page
|
||||
;; tree is built (a perform there raises VmSuspended under http-listen).
|
||||
(let ((principal (host/current-principal req)))
|
||||
(let ((body-html (host/blog-render r))
|
||||
(let (;; composition objects: a record with a :body renders via the render-fold
|
||||
;; (host/comp-render) against a context (auth from the principal); else the
|
||||
;; legacy sx_content path. The SAME object renders differently per context.
|
||||
(body-html (if (get r :body)
|
||||
(host/comp-render (get r :body) (if (nil? principal) {} {"auth" "yes"}))
|
||||
(host/blog-render r)))
|
||||
;; all relation blocks (Related, Tags, Types, Tagged-with-this …)
|
||||
;; come from iterating the registry — one section, registry-driven.
|
||||
(relations (host/blog--relations-or-hint slug (not (nil? principal))))
|
||||
|
||||
Reference in New Issue
Block a user