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)"