;; lib/host/compose.sx — the composition / object 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/text/card) + ref + recursion (tmpl). 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). ;; Self-contained (no blog deps) so the model can be proven in isolation. ;; ── predicates for `when` (over the context environment) ──────────── (define host/comp--pred? (fn (pred ctx) (let ((op (str (first pred)))) (cond ((= op "has") (not (nil? (get ctx (str (first (rest pred))))))) ((= op "eq") (= (str (get ctx (str (first (rest pred))))) (str (first (rest (rest pred)))))) ((= 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. (define host/comp--field (fn (k ctx) (let ((item (get ctx "item")) (key (str k))) (if (and item (not (nil? (get item key)))) (str (get item key)) (str (or (get ctx key) "")))))) ;; the source collection for `each`: literal items, the :item's :children (trees), or a ;; named list field on the :item. (A graph-query source is wiring step 3, plan roadmap.) (define host/comp--source (fn (src ctx) (let ((op (str (first src))) (item (get ctx "item"))) (cond ((= op "items") (rest src)) ((= op "children") (if item (or (get item "children") (list)) (list))) ((= op "field") (if item (or (get item (str (first (rest src)))) (list)) (list))) (else (list)))))) ;; ── 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) (if (empty? branches) "" (let ((br (first branches)) (bh (str (first (first branches))))) (cond ((= bh "else") (host/comp--render (first (rest br)) ctx)) ((= 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) (let ((depth (or (get ctx "depth") 0))) (if (> depth 40) "(max depth)" (reduce (fn (acc item) (str acc (host/comp--render tmpl (merge ctx {"item" item "depth" (+ depth 1)})))) "" (host/comp--source src ctx)))))) ;; card leaf (proof: a labelled box; in the host this renders via the card-type's :template). (define host/comp--card (fn (ctype fields) (str "
" (reduce (fn (acc k) (str acc "" k ": " (str (get fields k)) " ")) "" (keys fields)) "
"))) (define host/comp--render (fn (node ctx) (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 "
" (host/comp--render-all args ctx) "
")) ((= h "grid") (str "
" (host/comp--render-all args ctx) "
")) ((= h "alt") (host/comp--alt-pick args ctx)) ((= h "each") (host/comp--each (first args) (first (rest args)) ctx)) ((= h "field") (str "" (host/comp--field (first args) ctx) "")) ((= h "text") (str (first 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)) (else "")))))) ;; public entry: render a composition node against a context environment. (define host/comp-render (fn (node ctx) (host/comp--render node ctx)))