coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

host: factor the shared composition CORE — one fold, N domains (composition step 8)

Browse Source 
The roadmap's capstone: now that two folds exist (render, execute), extract the machinery
they share. host/comp-fold (compose.sx) is the reusable core — the seq/alt/each combinator
dispatch + the `when` predicate set (host/comp--pred?) + the context-environment + the `each`
source (host/comp--source) + recursion + the depth guard, ALL in one place. A domain plugs in
via a small dict {:empty :combine :leaf :overflow}; only its leaves and how results combine
differ:
  render  = {:empty ""     :combine str    …}  leaf -> markup (+ row/grid layout combinators)
  execute = {:empty (list) :combine concat …}  leaf -> effect

host/comp-render and host/exec-run are now one-liners over host/comp-fold with their domain.
execute.sx shed its own seq/alt/each dispatch — it's just a dict + a leaf. A THIRD domain
(eval/reduce/extent over the same algebra) is now only a new dict + leaf, no new control flow.

Both folds went through the core with ZERO behaviour change: new tests/compose.sx exercises
the core + render domain directly (17/17 — leaves, seq, row, alt+when (has/eq/not), each
(items/query/empty), tmpl recursion over a (children) tree + depth guard, ref transclude, one
object two contexts); execute 13/13; blog 162/164 (2 pre-existing relate-picker fails). Full
host conformance 388/390. Wired tests/compose.sx into conformance.

plans/composition-objects.md roadmap steps 1-8 COMPLETE.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
giles
2026-06-30 23:53:56 +00:00
parent ed68b9883d
commit e12e314bc3
5 changed files with 190 additions and 119 deletions
Download Patch File Download Diff File Expand all files Collapse all files

125
lib/host/compose.sx
View File

@@ -1,15 +1,19 @@
;; lib/host/compose.sx — the composition / object render-fold (plans/composition-objects.md).
;; lib/host/compose.sx — the composition algebra + its render-fold (plans/composition-objects.md).
;;
;; 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
;; (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
;; guards. The object's CID is its DEFINITION; render is the EXECUTION (per context+data).
;; An object's :body is a composition node — a tiny language over object refs:
;; (seq …) sequence (row/grid …) layout (alt (when P n)… (else n)) conditional
;; (each src tmpl) iteration + domain leaves + (tmpl NAME) recursion
;;
;; The combinator dispatch (seq/alt/each), the `when` predicate set, the context-environment,
;; the `each` source, and recursion are SHARED by every domain — they live in the CORE below
;; (host/comp-fold). A domain plugs in via a small dict {:empty :combine :leaf :overflow};
;; only the leaves and how results combine differ. The render-fold (render → HTML) is the
;; first such domain; the execute-fold (execute → effects, lib/host/execute.sx) is the second.
;; The object's CID is its DEFINITION; a fold is the EXECUTION (per context + data + domain).
;; Self-contained (no blog deps) so the model can be proven in isolation.
;; ── predicates for `when` (over the context environment) ────────────
;; ── shared machinery (domain-agnostic) ──────────────────────────────
;; predicates for `when`, over the context environment.
(define host/comp--pred?
(fn (pred ctx)
(let ((op (str (first pred))))
@@ -19,7 +23,7 @@
((= op "not") (not (host/comp--pred? (first (rest pred)) ctx)))
(else false)))))
;; the value of a leaf (field): the current :item's key, else the context's key.
;; the value of a field: the current :item's key, else the context's key.
(define host/comp--field
(fn (k ctx)
(let ((item (get ctx "item")) (key (str k)))
@@ -27,12 +31,10 @@
(str (get item key))
(str (or (get ctx key) ""))))))
;; the source collection for `each`: literal items, the :item's :children (trees), a
;; 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.
;; the source collection for `each`: literal items, the :item's :children (trees), a named
;; list field on the :item, or a GRAPH QUERY. `(query REL TYPE)` is data-driven: it delegates
;; to a resolver 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.
(define host/comp--source
(fn (src ctx)
(let ((op (str (first src))) (item (get ctx "item")))
@@ -44,40 +46,54 @@
(if qfn (qfn (rest src) ctx) (list))))
(else (list))))))
;; ── template registry (recursion: a template may reference itself by name) ──
;; template registry (recursion: a template may reference itself by name).
(define host/comp--tmpls (dict))
(define host/comp--def-tmpl! (fn (name node) (dict-set! host/comp--tmpls name node)))
;; ── the render-fold (the interpreter) ───────────────────────────────
(define host/comp--render-all
(fn (nodes ctx) (reduce (fn (acc n) (str acc (host/comp--render n ctx))) "" nodes)))
;; alt: render the FIRST branch whose `when` holds (or `else`) — recursive first-match so
;; a branch that legitimately renders empty isn't skipped.
(define host/comp--alt-pick
(fn (branches ctx)
;; ── the CORE fold framework (build once, reuse per domain) ──────────
;; host/comp-fold walks seq/alt/each generically, parameterised by a DOMAIN dict:
;; :empty — the zero result ("" for render, (list) for execute)
;; :combine — merge two results (str for render, concat for execute)
;; :overflow — the depth-guard result (a string / an effect)
;; :leaf — (node ctx dom) -> result for any non-core head: the domain's leaves AND its
;; own extra combinators (e.g. render's row/grid), which may recurse via the core.
;; seq, alt+when, each+source, the context-environment, recursion, and the depth guard are
;; handled HERE, once. A new domain (render, execute, eval, …) is just a new dict.
(define host/comp--fold-all
(fn (nodes ctx dom)
(reduce (fn (acc n) ((get dom :combine) acc (host/comp-fold n ctx dom))) (get dom :empty) nodes)))
(define host/comp--fold-alt
(fn (branches ctx dom)
(if (empty? branches)
""
(get dom :empty)
(let ((br (first branches)) (bh (str (first (first branches)))))
(cond
((= bh "else") (host/comp--render (first (rest br)) ctx))
((= bh "else") (host/comp-fold (first (rest br)) ctx dom))
((= bh "when") (if (host/comp--pred? (first (rest br)) ctx)
(host/comp--render (first (rest (rest br))) ctx)
(host/comp--alt-pick (rest branches) ctx)))
(else (host/comp--alt-pick (rest branches) ctx)))))))
;; each: eval source -> items; render template per item with :item bound + :depth+1
;; (depth guard backstops runaway recursion; trees terminate naturally on empty source).
(define host/comp--each
(fn (src tmpl ctx)
(host/comp-fold (first (rest (rest br))) ctx dom)
(host/comp--fold-alt (rest branches) ctx dom)))
(else (host/comp--fold-alt (rest branches) ctx dom)))))))
(define host/comp--fold-each
(fn (src body ctx dom)
(let ((depth (or (get ctx "depth") 0)))
(if (> depth 40)
"<em>(max depth)</em>"
(get dom :overflow)
(reduce
(fn (acc item)
(str acc (host/comp--render tmpl (merge ctx {"item" item "depth" (+ depth 1)}))))
"" (host/comp--source src ctx))))))
((get dom :combine) acc (host/comp-fold body (merge ctx {"item" item "depth" (+ depth 1)}) dom)))
(get dom :empty) (host/comp--source src ctx))))))
(define host/comp-fold
(fn (node ctx dom)
(if (not (= (type-of node) "list"))
((get dom :leaf) node ctx dom)
(let ((h (str (first node))))
(cond
((= h "seq") (host/comp--fold-all (rest node) ctx dom))
((= h "alt") (host/comp--fold-alt (rest node) ctx dom))
((= h "each") (host/comp--fold-each (first (rest node)) (first (rest (rest node))) ctx dom))
(else ((get dom :leaf) node ctx dom)))))))
;; ── the RENDER domain (render → HTML): leaves + layout combinators ──
;; card leaf (proof: a labelled box; in the host this renders via the card-type's :template).
(define host/comp--card
(fn (ctype fields)
@@ -85,29 +101,30 @@
(reduce (fn (acc k) (str acc "<b>" k ":</b> " (str (get fields k)) " ")) "" (keys fields))
"</div>")))
(define host/comp--render
(fn (node ctx)
;; render-leaf handles everything that isn't a core combinator: the layout combinators
;; row/grid (which recurse via the core), the leaves field/val/text/card, transclusion (ref),
;; and named-template recursion (tmpl). `field` wraps its value in a <span>; `val` is the raw
;; value (no markup) for attributes (href/src).
(define host/comp--render-leaf
(fn (node ctx dom)
(if (not (= (type-of node) "list"))
(str node)
(let ((h (str (first node))) (args (rest node)))
(cond
((= h "seq") (host/comp--render-all args ctx))
((= h "row") (str "<div class=\"row\" style=\"display:flex;gap:1em\">" (host/comp--render-all args ctx) "</div>"))
((= h "grid") (str "<div class=\"grid\" style=\"display:grid;gap:1em\">" (host/comp--render-all args ctx) "</div>"))
((= h "alt") (host/comp--alt-pick args ctx))
((= h "each") (host/comp--each (first args) (first (rest args)) ctx))
((= h "row") (str "<div class=\"row\" style=\"display:flex;gap:1em\">" (host/comp--fold-all args ctx dom) "</div>"))
((= h "grid") (str "<div class=\"grid\" style=\"display:grid;gap:1em\">" (host/comp--fold-all args ctx dom) "</div>"))
((= 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 "card") (host/comp--card (str (first args)) (first (rest args))))
;; ref: TRANSCLUDE another object by id/CID — fetch it and render its body. Like
;; `query`, this delegates to a resolver bound in the context (the host supplies
;; graph access) so compose.sx stays self-contained. A join in the Merkle DAG is
;; free: two bodies can (ref) the same child id (content-addressed).
((= h "ref") (let ((rfn (get ctx "ref")))
(if rfn (rfn (str (first args)) ctx) "")))
((= h "tmpl") (host/comp--render (get host/comp--tmpls (str (first args))) ctx))
;; ref: TRANSCLUDE another object by id/CID via a context resolver (the host supplies
;; graph access) so compose.sx stays self-contained; a join in the Merkle DAG is free.
((= h "ref") (let ((rfn (get ctx "ref"))) (if rfn (rfn (str (first args)) ctx) "")))
((= h "tmpl") (host/comp-fold (get host/comp--tmpls (str (first args))) ctx dom))
(else ""))))))
;; public entry: render a composition node against a context environment.
(define host/comp-render (fn (node ctx) (host/comp--render node ctx)))
(define host/comp--render-dom
{:empty "" :combine str :overflow "<em>(max depth)</em>" :leaf host/comp--render-leaf})
;; public entry: render a composition node against a context environment -> HTML string.
(define host/comp-render (fn (node ctx) (host/comp-fold node ctx host/comp--render-dom)))