rose-ash/lib/host/compose.sx

;; 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/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).
;; 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), 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.
(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)))
        ((= op "query")    (let ((qfn (get ctx "query")))
                             (if qfn (qfn (rest src) ctx) (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)
        "<em>(max depth)</em>"
        (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 "<div class=\"card card-" ctype "\">"
      (reduce (fn (acc k) (str acc "<b>" k ":</b> " (str (get fields k)) " ")) "" (keys fields))
      "</div>")))

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

;; public entry: render a composition node against a context environment.
(define host/comp-render (fn (node ctx) (host/comp--render node ctx)))