giles
e12e314bc3
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>
81 lines
4.1 KiB
Plaintext
81 lines
4.1 KiB
Plaintext
;; 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 "<p>hi</p>")) {}) "<p>hi</p>")
|
|
(host-cp-test "field wraps the value in a span; reads the context"
|
|
(host/comp-render (quote (field :title)) {"title" "Hello"}) "<span>Hello</span>")
|
|
(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)) {}) "<span></span>")
|
|
|
|
;; -- 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"))) {})
|
|
"<div class=\"row\" style=\"display:flex;gap:1em\">AB</div>")
|
|
|
|
;; -- 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 "<li>") (field :n) (text "</li>")))) {})
|
|
"<li><span>x</span></li><li><span>y</span></li>")
|
|
(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"}))})
|
|
"<span>One</span><span>Two</span>")
|
|
|
|
;; -- 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)})}})
|
|
"<span>root</span><span>a</span><span>b</span>")
|
|
|
|
;; -- 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 "<card:" id ">"))}) "<card:c1>")
|
|
(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}))
|