rose-ash/lib/host/compose.sx

;; lib/host/compose.sx — the composition algebra + its render-fold (plans/composition-objects.md).
;;
;; 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.

;; ── shared machinery (domain-agnostic) ──────────────────────────────
;; 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 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. `(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")))
      (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 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-fold (first (rest br)) ctx dom))
          ((= bh "when") (if (host/comp--pred? (first (rest br)) 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)
        (get dom :overflow)
        (reduce
          (fn (acc item)
            ((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)
    (str "<div class=\"card card-" ctype "\">"
      (reduce (fn (acc k) (str acc "<b>" k ":</b> " (str (get fields k)) " ")) "" (keys fields))
      "</div>")))

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

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

;; ── a THIRD domain (deps → the object ids a composition transcludes) ──
;; Proof of step 8's claim "a new domain is just a dict + leaf": no new control flow — seq/
;; alt/each come from the core unchanged; only the leaf + accumulator are new. The deps-leaf
;; collects `(ref ID)` ids; everything else contributes nothing. Useful in its own right: the
;; static transclusion set of a body (which card objects it pulls in — the contains DAG for a
;; (seq (ref c0) (each … (ref …))) body). Context-specific (alt picks the taken branch).
(define host/comp--deps-leaf
  (fn (node ctx dom)
    (if (and (= (type-of node) "list") (= (str (first node)) "ref"))
      (list (str (first (rest node))))
      (list))))
(define host/comp--deps-dom
  {:empty (list) :combine concat :overflow (list) :leaf host/comp--deps-leaf})
(define host/comp-deps (fn (node ctx) (host/comp-fold node ctx host/comp--deps-dom)))