host: each-source = graph query — the data-driven each (composition roadmap step 3)

An object's `each` source can now be a GRAPH QUERY: `(query is-a TYPE)` resolves to
whatever is-a TYPE *right now* — the list isn't baked into the body, it's the live graph.
The object's `each` IS the query; the render is the run over current data (the unifying
property, now over real data).

compose.sx stays self-contained: the `query` source delegates to a resolver bound in the
render context under "query" — it asks the context for data, never reaching into the graph
itself. The host supplies graph access via host/blog--comp-query (`(query is-a TYPE)` ->
host/blog-instances-of -> full records) injected by host/blog--comp-ctx (auth + resolver);
the post handler renders :body against that context.

Added a `val` leaf — the raw field value with no markup wrapper, for use inside attributes
(href/src). `field` stays span-wrapped for display; `(val :slug)` makes a real link in the
each template. /compose-demo's each is now a live (query is-a compose-item) over two seeded
instances instead of a baked literal list.

Verified end-to-end via a focused harness eval over the full relations+persist+blog stack
(query iterates real instances; clean href via val; empty query -> empty, not an error).
Blog suite 151/153 — the 2 fails ("relate-options load-more sentinel", "related picker
offers all posts") are PRE-EXISTING (clean HEAD is 149/151 with the identical 2 fails, a
relate-picker pagination-boundary issue) and unrelated to composition; my 2 new tests pass.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
2026-06-30 20:10:49 +00:00
parent bfb91819d9
commit 29aa7cd70f
4 changed files with 72 additions and 8 deletions

View File

@@ -527,11 +527,36 @@
(fn (slug body) (fn (slug body)
(let ((r (host/blog-get slug))) (let ((r (host/blog-get slug)))
(when r (host/blog--write! slug (merge r {:body body})))))) (when r (host/blog--write! slug (merge r {:body body}))))))
;; The resolver for the composition `each` graph-query source (compose.sx asks the context
;; for "query"). `(query REL TYPE)` -> the objects related to TYPE by REL, as full records
;; so the per-item template can field them. Today the supported relation is is-a (TYPE's
;; transitive instances, via host/blog-instances-of); the dispatch leaves room for more.
;; This is the DATA-DRIVEN each source — the object's `each` is the query, the render is
;; the run over whatever the graph currently holds.
(define host/blog--comp-query
(fn (qargs ctx)
(let ((rel (str (first qargs))) (type (str (first (rest qargs)))))
(cond
((= rel "is-a") (map host/blog-get (host/blog-instances-of type)))
(else (list))))))
;; the render context for a :body: auth from the principal + the graph-query resolver.
(define host/blog--comp-ctx
(fn (principal)
(merge (if (nil? principal) {} {"auth" "yes"})
{"query" host/blog--comp-query})))
;; Seed a live demo of the composition fold: one object, rendered by host/comp-render, that ;; 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. ;; shows seq + alt(when auth) + row(par) + each — and renders DIFFERENTLY logged-in vs out.
(define host/blog-seed-compose-demo! (define host/blog-seed-compose-demo!
(fn () (fn ()
(begin (begin
;; a demo type + two instances, so the each(query …) below iterates REAL graph data —
;; the list isn't baked into the body, it's whatever is-a compose-item right now.
(host/blog-seed! "compose-item" "Compose Item" "(article (h1 \"Compose Item\"))" "published")
(host/blog-relate! "compose-item" "type" "subtype-of")
(host/blog-seed! "compose-item-revel" "Revel Show" "(article (h1 \"Revel Show\"))" "published")
(host/blog-seed! "compose-item-pub" "Pub Night" "(article (h1 \"Pub Night\"))" "published")
(host/blog-relate! "compose-item-revel" "compose-item" "is-a")
(host/blog-relate! "compose-item-pub" "compose-item" "is-a")
(host/blog-seed! "compose-demo" "Composition Demo" (host/blog-seed! "compose-demo" "Composition Demo"
"(article (h1 \"Composition Demo\") (p \"Rendered via the composition fold.\"))" "published") "(article (h1 \"Composition Demo\") (p \"Rendered via the composition fold.\"))" "published")
(host/blog--set-body! "compose-demo" (host/blog--set-body! "compose-demo"
@@ -542,9 +567,9 @@
(text "<h3>Two columns (par)</h3>") (text "<h3>Two columns (par)</h3>")
(row (text "<div style=\"flex:1;border:1px solid #ccc;padding:0.5em\">Column A</div>") (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 "<div style=\"flex:1;border:1px solid #ccc;padding:0.5em\">Column B</div>"))
(text "<h3>A list (each)</h3><ul>") (text "<h3>A list (each over a graph query)</h3><ul>")
(each (items {:name "Revel Show" :date "Aug"} {:name "Pub Night" :date "Jun"}) (each (query is-a compose-item)
(seq (text "<li>") (field :name) (text "") (field :date) (text "</li>"))) (seq (text "<li><a href=\"/") (val :slug) (text "\">") (field :title) (text "</a></li>")))
(text "</ul>"))))))) (text "</ul>")))))))
;; replace every (field "name") node in a parsed template tree with values[name] ("" if ;; 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. ;; absent). Pure: a tree-walk over the already-parsed template + pre-fetched values.
@@ -1128,7 +1153,7 @@
;; (host/comp-render) against a context (auth from the principal); else the ;; (host/comp-render) against a context (auth from the principal); else the
;; legacy sx_content path. The SAME object renders differently per context. ;; legacy sx_content path. The SAME object renders differently per context.
(body-html (if (get r :body) (body-html (if (get r :body)
(host/comp-render (get r :body) (if (nil? principal) {} {"auth" "yes"})) (host/comp-render (get r :body) (host/blog--comp-ctx principal))
(host/blog-render r))) (host/blog-render r)))
;; all relation blocks (Related, Tags, Types, Tagged-with-this …) ;; all relation blocks (Related, Tags, Types, Tagged-with-this …)
;; come from iterating the registry — one section, registry-driven. ;; come from iterating the registry — one section, registry-driven.

View File

@@ -2,7 +2,9 @@
;; ;;
;; An object's :body is a composition node — a tiny UI language over object refs. The ;; An object's :body is a composition node — a tiny UI language over object refs. The
;; render-fold below is its interpreter. Four combinators (seq/row/alt/each) + leaves ;; render-fold below is its interpreter. Four combinators (seq/row/alt/each) + leaves
;; (field/text/card) + ref + recursion (tmpl). The context is an EXTENSIBLE ENVIRONMENT: ;; (field/val/text/card) + ref + recursion (tmpl). `field` wraps its value in a span for
;; display; `val` is the raw value (no markup) for use inside attributes (href/src).
;; The context is an EXTENSIBLE ENVIRONMENT:
;; `when` reads it, `each` extends it (:item, :depth). Same predicate set as the type ;; `when` reads it, `each` extends it (:item, :depth). Same predicate set as the type
;; guards. The object's CID is its DEFINITION; render is the EXECUTION (per context+data). ;; guards. The object's CID is its DEFINITION; render is the EXECUTION (per context+data).
;; Self-contained (no blog deps) so the model can be proven in isolation. ;; Self-contained (no blog deps) so the model can be proven in isolation.
@@ -25,8 +27,12 @@
(str (get item key)) (str (get item key))
(str (or (get ctx key) "")))))) (str (or (get ctx key) ""))))))
;; the source collection for `each`: literal items, the :item's :children (trees), or a ;; the source collection for `each`: literal items, the :item's :children (trees), a
;; named list field on the :item. (A graph-query source is wiring step 3, plan roadmap.) ;; named list field on the :item, or a GRAPH QUERY. The query source `(query REL TYPE)`
;; is data-driven: it delegates to a resolver function bound in the context under "query"
;; (the host injects one with graph access), so compose.sx stays self-contained — it asks
;; the context for the data, it doesn't reach into the graph itself. `src` minus its head
;; (`(REL TYPE …)`) + the live ctx are passed through; the resolver returns a list of items.
(define host/comp--source (define host/comp--source
(fn (src ctx) (fn (src ctx)
(let ((op (str (first src))) (item (get ctx "item"))) (let ((op (str (first src))) (item (get ctx "item")))
@@ -34,6 +40,8 @@
((= op "items") (rest src)) ((= op "items") (rest src))
((= op "children") (if item (or (get item "children") (list)) (list))) ((= op "children") (if item (or (get item "children") (list)) (list)))
((= op "field") (if item (or (get item (str (first (rest src)))) (list)) (list))) ((= op "field") (if item (or (get item (str (first (rest src)))) (list)) (list)))
((= op "query") (let ((qfn (get ctx "query")))
(if qfn (qfn (rest src) ctx) (list))))
(else (list)))))) (else (list))))))
;; ── template registry (recursion: a template may reference itself by name) ── ;; ── template registry (recursion: a template may reference itself by name) ──
@@ -89,6 +97,7 @@
((= h "alt") (host/comp--alt-pick args ctx)) ((= h "alt") (host/comp--alt-pick args ctx))
((= h "each") (host/comp--each (first args) (first (rest args)) ctx)) ((= h "each") (host/comp--each (first args) (first (rest args)) ctx))
((= h "field") (str "<span>" (host/comp--field (first args) ctx) "</span>")) ((= h "field") (str "<span>" (host/comp--field (first args) ctx) "</span>"))
((= h "val") (host/comp--field (first args) ctx)) ;; raw value, no markup — for attributes
((= h "text") (str (first args))) ((= h "text") (str (first args)))
((= h "card") (host/comp--card (str (first args)) (first (rest args)))) ((= h "card") (host/comp--card (str (first args)) (first (rest args))))
((= h "tmpl") (host/comp--render (get host/comp--tmpls (str (first args))) ctx)) ((= h "tmpl") (host/comp--render (get host/comp--tmpls (str (first args))) ctx))

View File

@@ -750,6 +750,31 @@
(list "ANON<span>X</span><span>Y</span>" "MEMBER<span>X</span><span>Y</span>")) (list "ANON<span>X</span><span>Y</span>" "MEMBER<span>X</span><span>Y</span>"))
(host-bl-test "post page renders :body (composition) over sx_content" (host-bl-test "post page renders :body (composition) over sx_content"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/cdoc/"))) "ANON") true) (contains? (dream-resp-body (host-bl-app (host-bl-req "/cdoc/"))) "ANON") true)
;; -- the each source can be a GRAPH QUERY: the list isn't baked into the body, it's
;; whatever is-a the type right now (data-driven). The resolver (host/blog--comp-query)
;; is injected into the render context by host/blog--comp-ctx. --
(host-bl-test "each(query is-a TYPE) iterates real graph instances"
(begin
(host/blog-seed! "qtype" "QType" "(p \"t\")" "published")
(host/blog-relate! "qtype" "type" "subtype-of")
(host/blog-seed! "qi-1" "Item One" "(p \"1\")" "published")
(host/blog-seed! "qi-2" "Item Two" "(p \"2\")" "published")
(host/blog-relate! "qi-1" "qtype" "is-a")
(host/blog-relate! "qi-2" "qtype" "is-a")
(let ((out (host/comp-render
(quote (each (query is-a qtype)
(seq (text "<a href=\"/") (val :slug) (text "\">") (field :title) (text "</a>"))))
(host/blog--comp-ctx nil))))
;; field wraps in <span> (display); val is raw (for the href attribute).
(list (contains? out "Item One") (contains? out "Item Two")
(contains? out "/qi-1") (contains? out "<span>Item One</span>"))))
(list true true true true))
;; a query with no matching instances renders empty (not an error) — robustness.
(host-bl-test "each(query is-a TYPE) with no instances renders empty"
(host/comp-render
(quote (each (query is-a no-such-type) (field :title)))
(host/blog--comp-ctx nil))
"")
(host-bl-test "a post with no schema'd type is vacuously valid" (host-bl-test "a post with no schema'd type is vacuously valid"
(host/blog-type-valid? "ppost" "(p \"anything\")") true) (host/blog-type-valid? "ppost" "(p \"anything\")") true)
(host-bl-test "edit-submit rejects content violating the type schema (not saved)" (host-bl-test "edit-submit rejects content violating the type schema (not saved)"

View File

@@ -100,7 +100,12 @@ Transclusion = a `ref` leaf. Sort/filter/limit/group = the *source query* langua
2. Wire it to objects: a document's `:body` is a composition node; `contains` forks carry order; 2. Wire it to objects: a document's `:body` is a composition node; `contains` forks carry order;
`host/blog-render` dispatches to the render-fold when `:body` is present (else the legacy `host/blog-render` dispatches to the render-fold when `:body` is present (else the legacy
`sx_content` path). Card leaves render via the existing card-type `:template`. `sx_content` path). Card leaves render via the existing card-type `:template`.
3. `each` source = a graph query (`(query is-a Event)``host/blog-instances-of`) — data-driven. 3. **(done)** `each` source = a graph query: `(query is-a TYPE)` resolves via a `query`
resolver injected into the render context (`host/blog--comp-ctx` binds
`host/blog--comp-query``host/blog-instances-of` → records). compose.sx stays
self-contained — it asks the context for the data; the host supplies graph access. The
list isn't baked into the body; it's whatever is-a TYPE *right now*. (`/compose-demo`
each is now a live query over seeded `compose-item` instances.)
4. Live context: route auth/device/locale into the context; reactive values later. 4. Live context: route auth/device/locale into the context; reactive values later.
5. The typed importer decomposes Ghost Lexical into card objects + a `contains` body (cards-as- 5. The typed importer decomposes Ghost Lexical into card objects + a `contains` body (cards-as-
objects), instead of one `sx_content` string. objects), instead of one `sx_content` string.