host: live context — device/locale routed into the render-fold (composition roadmap step 4)

The render context is now the live EXECUTION environment: host/blog--comp-ctx reads device
(mobile/desktop from User-Agent) and locale (from Accept-Language) PURELY from the request
headers — no perform — alongside auth + the graph-query resolver. So the SAME composition
object renders responsively/personalised: `(alt (when (eq "device" "mobile") …) …)` is a
responsive layout, `(when (eq "locale" "fr") …)` a localised variant. The object (its
when-variants) is the definition; the context picks which path renders.

host/blog--device-of / host/blog--locale-of; comp-ctx now (principal req) — post handler
passes req; /compose-demo gains a device-variant block. Reactive/live values plug into the
same context later with no new combinators (the plan's "make the context live" axis).

Verified via focused harness eval (mobile+fr vs desktop+en contexts render M/D variants;
no-req ctx omits device). Tests added.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
2026-06-30 20:43:06 +00:00
parent 29aa7cd70f
commit 5ead6e73c7
2 changed files with 40 additions and 7 deletions

View File

@@ -764,7 +764,7 @@
(let ((out (host/comp-render
(quote (each (query is-a qtype)
(seq (text "<a href=\"/") (val :slug) (text "\">") (field :title) (text "</a>"))))
(host/blog--comp-ctx nil))))
(host/blog--comp-ctx nil nil))))
;; field wraps in <span> (display); val is raw (for the href attribute).
(list (contains? out "Item One") (contains? out "Item Two")
(contains? out "/qi-1") (contains? out "<span>Item One</span>"))))
@@ -773,8 +773,22 @@
(host-bl-test "each(query is-a TYPE) with no instances renders empty"
(host/comp-render
(quote (each (query is-a no-such-type) (field :title)))
(host/blog--comp-ctx nil))
(host/blog--comp-ctx nil nil))
"")
;; -- live context: the SAME object renders a responsive variant per request (device from
;; the User-Agent, locale from Accept-Language) — context is the execution environment. --
(host-bl-test "comp-ctx reads device + locale from the request headers"
(let ((mob (host/blog--comp-ctx nil (dream-request "GET" "/x" {"user-agent" "X iPhone Y" "accept-language" "fr-FR,fr"} "")))
(desk (host/blog--comp-ctx nil (dream-request "GET" "/x" {"user-agent" "Mozilla Linux" "accept-language" "en-US"} ""))))
(list (get mob "device") (get mob "locale") (get desk "device") (get desk "locale")))
(list "mobile" "fr" "desktop" "en"))
(host-bl-test "one object renders a device-specific variant via (alt (when (eq device …)))"
(let ((body (quote (alt (when (eq "device" "mobile") (text "M")) (else (text "D")))))
(mob (dream-request "GET" "/x" {"user-agent" "iPhone"} ""))
(desk (dream-request "GET" "/x" {"user-agent" "Linux"} "")))
(list (host/comp-render body (host/blog--comp-ctx nil mob))
(host/comp-render body (host/blog--comp-ctx nil desk))))
(list "M" "D"))
(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)"