giles
af3d81d108
Two concrete demonstrations of the composition architecture: THIRD DOMAIN (proves step 8's "a new domain is just a dict + leaf, no new control flow"). host/comp-deps folds a composition to the object ids it TRANSCLUDES — the static contains DAG of a body. It reuses host/comp-fold's seq/alt/each dispatch verbatim; only the leaf (collect `(ref ID)`) + accumulator (concat) are new. Useful in its own right (what a (seq (ref c0) (each … (ref …))) body pulls in; context-specific — alt picks the taken branch). compose suite 20/20. LIVE EXECUTE-FOLD DEMO (makes step 7 tangible, parallel to /compose-demo for render). /workflow-demo runs ONE composition object's :body through host/exec-run — the SAME structure the render-fold would turn into HTML, folded by execute into a plan of effects (validate → branch on status → notify each recipient). host/blog-seed-workflow-demo! + host/blog-workflow- demo + route + serve.sh seed. Shows the behaviour model IS an execute-fold over a composition object — the same object the block editor authors. blog suite 165/165. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
94 lines
5.0 KiB
Plaintext
94 lines
5.0 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"))
|
|
|
|
;; -- a THIRD domain over the SAME core: deps (collect transcluded refs). Proves step 8 —
|
|
;; a new domain is just a dict + leaf, reusing seq/alt/each with no new control flow. --
|
|
(host-cp-test "deps collects the refs a seq body transcludes (the contains DAG)"
|
|
(host/comp-deps (quote (seq (ref "c0") (text "x") (ref "c1"))) {})
|
|
(list "c0" "c1"))
|
|
(host-cp-test "deps walks each — refs inside an iterated template are collected per item"
|
|
(host/comp-deps (quote (each (items {} {}) (ref "card"))) {})
|
|
(list "card" "card"))
|
|
(host-cp-test "deps follows alt's taken branch (context-specific transclusions)"
|
|
(list (host/comp-deps (quote (alt (when (has "auth") (ref "member")) (else (ref "guest")))) {"auth" "y"})
|
|
(host/comp-deps (quote (alt (when (has "auth") (ref "member")) (else (ref "guest")))) {}))
|
|
(list (list "member") (list "guest")))
|
|
|
|
(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}))
|