From bfb91819d9f375efc98875559191be27d89fa1b2 Mon Sep 17 00:00:00 2001 From: giles Date: Tue, 30 Jun 2026 17:24:29 +0000 Subject: [PATCH] =?UTF-8?q?host:=20wire=20:body=20into=20live=20rendering?= =?UTF-8?q?=20=E2=80=94=20composition=20fold=20is=20fold=20#1,=20live=20(r?= =?UTF-8?q?oadmap=20step=202)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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..> vs MEMBER<..>). Tests added; full blog suite still box-contended. Co-Authored-By: Claude Opus 4.8 --- lib/host/blog.sx | 36 +++++++++++++++++++++++++++++++++++- lib/host/conformance.sh | 1 + lib/host/serve.sh | 6 ++++++ lib/host/tests/blog.sx | 13 +++++++++++++ 4 files changed, 55 insertions(+), 1 deletion(-) diff --git a/lib/host/blog.sx b/lib/host/blog.sx index 3a4f4dc8..ea13c316 100644 --- a/lib/host/blog.sx +++ b/lib/host/blog.sx @@ -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 "

This whole page is one composition object, rendered by the fold — it renders differently depending on context.

") + (alt (when (has "auth") (text "

Members: you are logged in.

")) + (else (text "

Log in to see the member-only block.

"))) + (text "

Two columns (par)

") + (row (text "
Column A
") + (text "
Column B
")) + (text "

A list (each)

    ") + (each (items {:name "Revel Show" :date "Aug"} {:name "Pub Night" :date "Jun"}) + (seq (text "
  • ") (field :name) (text " — ") (field :date) (text "
    • "))) + (text "
"))))))) ;; 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)))) diff --git a/lib/host/conformance.sh b/lib/host/conformance.sh index cd258a5a..f7742cad 100755 --- a/lib/host/conformance.sh +++ b/lib/host/conformance.sh @@ -92,6 +92,7 @@ MODULES=( "lib/host/sx/kg-cards.sx" "lib/host/feed.sx" "lib/host/relations.sx" + "lib/host/compose.sx" "lib/host/blog.sx" "lib/host/page.sx" "lib/host/server.sx" diff --git a/lib/host/serve.sh b/lib/host/serve.sh index 3184322d..c271bc58 100755 --- a/lib/host/serve.sh +++ b/lib/host/serve.sh @@ -86,6 +86,7 @@ MODULES=( "lib/host/sx/kg-cards.sx" "lib/host/feed.sx" "lib/host/relations.sx" + "lib/host/compose.sx" "lib/host/blog.sx" "lib/host/server.sx" ) @@ -152,6 +153,11 @@ EPOCH=1 echo "(epoch $EPOCH)" echo "(eval \"(host/blog-seed-types!)\")" EPOCH=$((EPOCH+1)) + # Seed a live demo of the composition fold (plans/composition-objects.md): /compose-demo + # is one composition object rendered by host/comp-render — renders differently by context. + echo "(epoch $EPOCH)" + echo "(eval \"(host/blog-seed-compose-demo!)\")" + EPOCH=$((EPOCH+1)) # Load relation metadata (symmetry/labels) from the relation-posts into the # in-memory cache, so render paths read it without a (VmSuspending) durable read. echo "(epoch $EPOCH)" diff --git a/lib/host/tests/blog.sx b/lib/host/tests/blog.sx index 5197bb47..f5cb0d5b 100644 --- a/lib/host/tests/blog.sx +++ b/lib/host/tests/blog.sx @@ -737,6 +737,19 @@ (host-bl-test "POST /import rejects a non-list body -> 400" (dream-status (host-bl-wapp (host-bl-send "POST" "/import" "Bearer good" "text/sx" "{:x 1}"))) 400) + +;; -- composition objects: a record with :body renders via the render-fold -- +(host-bl-test "a record's :body renders via the fold, different per context" + (begin + (host/blog-put! "cdoc" "C" "(p \"fallback\")" "published") + (host/blog--set-body! "cdoc" + (quote (seq (alt (when (has "auth") (text "MEMBER")) (else (text "ANON"))) + (each (items {:name "X"} {:name "Y"}) (field :name))))) + (list (host/comp-render (host/blog-body-of "cdoc") {}) + (host/comp-render (host/blog-body-of "cdoc") {"auth" "y"}))) + (list "ANONXY" "MEMBERXY")) +(host-bl-test "post page renders :body (composition) over sx_content" + (contains? (dream-resp-body (host-bl-app (host-bl-req "/cdoc/"))) "ANON") true) (host-bl-test "a post with no schema'd type is vacuously valid" (host/blog-type-valid? "ppost" "(p \"anything\")") true) (host-bl-test "edit-submit rejects content violating the type schema (not saved)"