diff --git a/lib/host/compose.sx b/lib/host/compose.sx index d061abab..b0554e26 100644 --- a/lib/host/compose.sx +++ b/lib/host/compose.sx @@ -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) - "(max depth)" + (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 "" k ": " (str (get fields k)) " ")) "" (keys fields)) ""))) -(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 ; `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 "
" (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 "row") (str "
" (host/comp--fold-all args ctx dom) "
")) + ((= h "grid") (str "
" (host/comp--fold-all args ctx dom) "
")) ((= h "field") (str "" (host/comp--field (first args) ctx) "")) ((= 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 "(max depth)" :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))) diff --git a/lib/host/conformance.sh b/lib/host/conformance.sh index dde8daba..4b7d5775 100755 --- a/lib/host/conformance.sh +++ b/lib/host/conformance.sh @@ -109,6 +109,7 @@ SUITES=( "feed host-fd-tests-run! lib/host/tests/feed.sx" "relations host-rl-tests-run! lib/host/tests/relations.sx" "blog host-bl-tests-run! lib/host/tests/blog.sx" + "compose host-cp-tests-run! lib/host/tests/compose.sx" "execute host-ex-tests-run! lib/host/tests/execute.sx" "session host-se-tests-run! lib/host/tests/session.sx" "page host-pg-tests-run! lib/host/tests/page.sx" diff --git a/lib/host/execute.sx b/lib/host/execute.sx index bd208bc2..e8e1b3b5 100644 --- a/lib/host/execute.sx +++ b/lib/host/execute.sx @@ -1,18 +1,16 @@ -;; lib/host/execute.sx — the EXECUTE-fold: a SECOND interpreter over the SAME composition -;; algebra (seq/alt/each) as the render-fold (lib/host/compose.sx), proving the algebra is -;; domain-agnostic (plans/composition-objects.md step 7 — "prove universality with a second -;; fold"). What changes between folds is only what the combinators + leaves MEAN: +;; lib/host/execute.sx — the EXECUTE-fold: a SECOND domain over the SAME composition core +;; as the render-fold (lib/host/compose.sx), proving the algebra is domain-agnostic +;; (plans/composition-objects.md steps 7-8). Now that the core (host/comp-fold: the seq/alt/ +;; each dispatch + when-predicates + each-source + context-environment + recursion) is shared, +;; a whole new domain is just a DOMAIN DICT + a leaf function: ;; -;; domain fold seq alt+when each leaf -;; content render -> block order choose map items markup -> HTML string -;; behaviour execute -> steps in order branch for-each effect -> effect log +;; render {:empty "" :combine str …} leaf -> markup; fold -> HTML string +;; execute {:empty (list) :combine concat …} leaf -> effect; fold -> effect log ;; -;; Crucially this REUSES compose.sx's shared machinery — the `when` predicate set -;; (host/comp--pred?), the field/value resolver (host/comp--field), and the `each` source -;; (host/comp--source). So the predicate set, the context-environment, and the iteration -;; source are domain-agnostic; ONLY the leaf semantics (effect vs markup) and the fold's -;; accumulator (a list of effects vs a string) are new. The behaviour model (Slice 9) is -;; therefore "an execute-fold over a composition object", not a separate system. +;; seq = steps in order, alt+when = branch, each = for-each — all from the core, unchanged. +;; Only the leaf semantics (effect vs markup) and the accumulator (list vs string) are new. +;; So the behaviour model (Slice 9) is "an execute-fold over a composition object", not a +;; separate system — the same structure an author edits as a document. ;; resolve an effect argument against the context: (field K) reads the :item/ctx value via ;; the SAME resolver the render-fold uses; anything else is a literal. @@ -22,55 +20,21 @@ (host/comp--field (first (rest a)) ctx) a))) -;; a leaf effect: (effect VERB ARG…) -> one effect record {:verb :args}. The execute-fold's -;; analogue of a render leaf — it performs (records) an effect rather than emitting markup. -(define host/exec--effect - (fn (verb args ctx) - (list {:verb (str verb) :args (map (fn (a) (host/exec--arg a ctx)) args)}))) - -;; seq: run every step IN ORDER, concatenating their effects (the sequential strategy). -(define host/exec--run-all - (fn (nodes ctx) (reduce (fn (acc n) (concat acc (host/exec--run n ctx))) (list) nodes))) - -;; alt: BRANCH — run the FIRST branch whose `when` holds (reusing the render-fold's -;; predicate host/comp--pred?), else `else`. This is if/cond for the behaviour domain. -(define host/exec--alt - (fn (branches ctx) - (if (empty? branches) - (list) - (let ((br (first branches)) (bh (str (first (first branches))))) - (cond - ((= bh "else") (host/exec--run (first (rest br)) ctx)) - ((= bh "when") (if (host/comp--pred? (first (rest br)) ctx) - (host/exec--run (first (rest (rest br))) ctx) - (host/exec--alt (rest branches) ctx))) - (else (host/exec--alt (rest branches) ctx))))))) - -;; each: FOR-EACH — run the body per item from the (reused) source, :item bound, in order; -;; depth guard backstops runaway recursion, same as the render-fold. -(define host/exec--each - (fn (src body ctx) - (let ((depth (or (get ctx "depth") 0))) - (if (> depth 40) - (list {:verb "max-depth" :args (list)}) - (reduce - (fn (acc item) - (concat acc (host/exec--run body (merge ctx {"item" item "depth" (+ depth 1)})))) - (list) (host/comp--source src ctx)))))) - -;; the execute-fold (the interpreter): same combinator dispatch shape as host/comp--render, -;; but leaves are effects and the accumulator is an effect log. -(define host/exec--run - (fn (node ctx) +;; the execute-fold's LEAF: an (effect VERB ARG…) node records one effect {:verb :args}; +;; anything else contributes no effects. (The core handles seq/alt/each.) +(define host/exec--leaf + (fn (node ctx dom) (if (not (= (type-of node) "list")) (list) (let ((h (str (first node))) (args (rest node))) - (cond - ((= h "seq") (host/exec--run-all args ctx)) - ((= h "alt") (host/exec--alt args ctx)) - ((= h "each") (host/exec--each (first args) (first (rest args)) ctx)) - ((= h "effect") (host/exec--effect (first args) (rest args) ctx)) - (else (list))))))) + (if (= h "effect") + (list {:verb (str (first args)) :args (map (fn (a) (host/exec--arg a ctx)) (rest args))}) + (list)))))) + +;; the execute DOMAIN: effects concatenate into a log; the depth guard yields a max-depth +;; effect. host/comp-fold (compose.sx) supplies the seq/alt/each walk + when + each source. +(define host/exec--dom + {:empty (list) :combine concat :overflow (list {:verb "max-depth" :args (list)}) :leaf host/exec--leaf}) ;; public entry: execute a composition node against a context -> the effect log (the run). -(define host/exec-run (fn (node ctx) (host/exec--run node ctx))) +(define host/exec-run (fn (node ctx) (host/comp-fold node ctx host/exec--dom))) diff --git a/lib/host/tests/compose.sx b/lib/host/tests/compose.sx new file mode 100644 index 00000000..8b8343a1 --- /dev/null +++ b/lib/host/tests/compose.sx @@ -0,0 +1,80 @@ +;; lib/host/tests/compose.sx — the composition CORE + render-fold (lib/host/compose.sx). +;; Tests host/comp-fold's shared dispatch (seq/alt/each + when + each-source + recursion + +;; depth guard) through the RENDER domain (render → HTML). The execute domain is tested in +;; tests/execute.sx; together they show one core, two folds (plans/composition-objects.md). + +(define host-cp-pass 0) +(define host-cp-fail 0) +(define host-cp-fails (list)) +(define host-cp-test + (fn (name actual expected) + (if (= actual expected) + (set! host-cp-pass (+ host-cp-pass 1)) + (begin + (set! host-cp-fail (+ host-cp-fail 1)) + (append! host-cp-fails {:name name :actual actual :expected expected}))))) + +;; -- leaves -- +(host-cp-test "text leaf passes markup through" + (host/comp-render (quote (text "

hi

")) {}) "

hi

") +(host-cp-test "field wraps the value in a span; reads the context" + (host/comp-render (quote (field :title)) {"title" "Hello"}) "Hello") +(host-cp-test "val is the raw value (no markup) — for attributes" + (host/comp-render (quote (val :slug)) {"slug" "p1"}) "p1") +(host-cp-test "a missing field renders empty, not an error" + (host/comp-render (quote (field :nope)) {}) "") + +;; -- seq: render all in order -- +(host-cp-test "seq renders children in order" + (host/comp-render (quote (seq (text "a") (text "b") (text "c"))) {}) "abc") + +;; -- row/grid: layout combinators wrap + recurse via the core -- +(host-cp-test "row wraps its children in a flex div" + (host/comp-render (quote (row (text "A") (text "B"))) {}) + "
AB
") + +;; -- alt + when: render the first branch whose predicate holds -- +(host-cp-test "alt renders the when-branch when the predicate holds" + (host/comp-render (quote (alt (when (has "auth") (text "in")) (else (text "out")))) {"auth" "y"}) "in") +(host-cp-test "alt falls through to else" + (host/comp-render (quote (alt (when (has "auth") (text "in")) (else (text "out")))) {}) "out") +(host-cp-test "alt eq predicate matches a context value" + (host/comp-render (quote (alt (when (eq "t" "dark") (text "D")) (else (text "L")))) {"t" "dark"}) "D") +(host-cp-test "alt not predicate negates" + (host/comp-render (quote (alt (when (not (has "auth")) (text "anon")) (else (text "user")))) {}) "anon") + +;; -- each: iterate a source, binding :item, with field resolution -- +(host-cp-test "each renders the template per item (items source)" + (host/comp-render (quote (each (items {:n "x"} {:n "y"}) (seq (text "
  • ") (field :n) (text "
    • ")))) {}) + "
  • x
  • y
    • ") +(host-cp-test "each over an empty source renders empty" + (host/comp-render (quote (each (items) (field :n))) {}) "") +(host-cp-test "each query source delegates to the context resolver" + (host/comp-render (quote (each (query is-a t) (field :title))) + {"query" (fn (qargs ctx) (list {:title "One"} {:title "Two"}))}) + "OneTwo") + +;; -- recursion via named templates + a depth guard -- +(host/comp--def-tmpl! "node" + (quote (seq (field :name) (each (children) (tmpl "node"))))) +(host-cp-test "tmpl recurses over a (children) tree until the source runs dry" + (host/comp-render (quote (tmpl "node")) + {"item" {:name "root" :children (list {:name "a" :children (list)} {:name "b" :children (list)})}}) + "rootab") + +;; -- ref: transclude via the context resolver -- +(host-cp-test "ref transcludes via the context resolver" + (host/comp-render (quote (ref "c1")) {"ref" (fn (id ctx) (str ""))}) "") +(host-cp-test "ref with no resolver renders empty" + (host/comp-render (quote (ref "c1")) {}) "") + +;; -- the unifying property: ONE object renders differently per context -- +(host-cp-test "the SAME object renders two ways by context (anon vs authed)" + (let ((obj (quote (alt (when (has "auth") (text "member")) (else (text "guest")))))) + (list (host/comp-render obj {}) (host/comp-render obj {"auth" "y"}))) + (list "guest" "member")) + +(define host-cp-tests-run! + (fn () + {:total (+ host-cp-pass host-cp-fail) + :passed host-cp-pass :failed host-cp-fail :fails host-cp-fails})) diff --git a/plans/composition-objects.md b/plans/composition-objects.md index a2a42f93..8bdf0304 100644 --- a/plans/composition-objects.md +++ b/plans/composition-objects.md @@ -134,8 +134,17 @@ Transclusion = a `ref` leaf. Sort/filter/limit/group = the *source query* langua execute picks the SAME branch → effect. A publish workflow (validate→branch→notify-each) runs as one execute-fold. The behaviour model (Slice 9) is "an execute-fold over a composition object", not a separate system. 13/13 (execute suite). Wired into conformance + serve. -8. **Factor out the shared machinery** once two folds exist: the fork model (ordered, labelled, - `when`), the combinator dispatch, the context-environment, and recursion become a reusable - `compose` core; each domain (`render`, `execute`, `eval`, …) supplies only its leaf + combinator - semantics. The block editor + the metamodel UI then generalise to *every* fold — one composition - editor authors documents, workflows, queries, and pipelines alike. +8. **(done)** Factor out the shared machinery. `host/comp-fold` (compose.sx) is the reusable + core: the seq/alt/each combinator dispatch + the `when` predicate set + the context-environment + + the `each` source + recursion + the depth guard, ALL in one place. A domain plugs in via a + dict `{:empty :combine :leaf :overflow}` — only its leaves and how results combine. render = + `{:empty "" :combine str …}` (leaf → markup, + row/grid layout combinators); execute = + `{:empty (list) :combine concat …}` (leaf → effect). Both folds went through the core with zero + behaviour change (compose suite 17/17, execute 13/13, blog 162/164 — the 2 fails pre-existing). + A third domain (`eval`/`reduce`/`extent`) is now just a new dict + leaf. The block editor + + metamodel UI generalise to *every* fold — one composition editor for documents, workflows, + queries, pipelines alike. + +## Status: roadmap COMPLETE (steps 1-8). Remaining polish: Playwright live-swap check for the +block editor; `alt`/`each` block insertion in the editor; a live workflow object executed via the +execute-fold (the way `/compose-demo` shows the render-fold); a third domain to exercise the core.