host: polish — a third fold domain (deps) + a live execute-fold demo (/workflow-demo)

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>
This commit is contained in:
2026-07-01 05:16:56 +00:00
parent 10bc091890
commit af3d81d108
5 changed files with 77 additions and 0 deletions

View File

@@ -856,6 +856,16 @@
"application/x-www-form-urlencoded" "ctype=card-text&text=added+block"))
(len (host/blog-body-refs "bdoc")))
2)
;; -- /workflow-demo: ONE composition object run through the EXECUTE-fold (step 7 live). The
;; same :body structure the render-fold renders, folded to an effect log (status=ready ->
;; validate, publish, notify each — not hold). --
(host-bl-test "GET /workflow-demo runs the composition through the execute-fold"
(begin
(host/blog-seed-workflow-demo!)
(let ((html (dream-resp-body (host-bl-app (host-bl-req "/workflow-demo")))))
(list (contains? html "validate") (contains? html "publish")
(contains? html "notify") (contains? html "hold"))))
(list true true true false))
(host-bl-test "a post with no schema'd type is vacuously valid"
(host/blog-type-valid? "ppost" "(p \"anything\")") true)
(host-bl-test "edit-submit rejects content violating the type schema (not saved)"

View File

@@ -74,6 +74,19 @@
(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)