diff --git a/lib/host/blog.sx b/lib/host/blog.sx index 8f7c5f6f..8935f9e4 100644 --- a/lib/host/blog.sx +++ b/lib/host/blog.sx @@ -1098,6 +1098,42 @@ "feature_image" "https://rose-ash.com/content/images/2026/07/61iN2uEt2ML._AC_SL1024_.jpg" "tags" (list "NT Live" "Films") "sx_content" "(article (img :src \"https://rose-ash.com/content/images/2026/07/61iN2uEt2ML._AC_SL1024_.jpg\" :alt \"NT Live Encore?\") (p \"Did you miss an NTLIVE performance at Rose Ash Village Hall? Or maybe you enjoyed it so much you want another chance to see it? We can book an encore with the National Theatre. Ticket price will be £10. If you are interested, take a look at the available days for each play below and please email village@rose-ash.com (or simply reply to this if you are reading it as an email) and let us know which plays you'd like to see when. We can't promise to make the date you request - but we will do our best! If none of these times suit - then let us know and we'll try harder! (you may have to stick the DVD in the slot yourself...) Don't forget to subscribe to rose-ash.com for emailed news of all things Rose Ash!\") (figure (img :src \"https://rose-ash.com/content/images/2026/07/LISTING.jpg\" :alt \"NT Live Encore?\") (figcaption \"Bryan Cranston (Breaking Bad) and Marianne Jean-Baptiste (Hard Truths) feature in a five-star, triumphantly acclaimed new production of Arthur Miller’s classic play, from visionary director Ivo Van Hove (A View from the Bridge).\")) (p \"ALL MY SONS encore possibilities: Sunday 5th July PM\") (figure (img :src \"https://rose-ash.com/content/images/2026/07/in.jpg\" :alt \"NT Live Encore?\") (figcaption \"Pegeen Flaherty’s life is turned upside down when a young man walks into her pub claiming that he’s killed his father. Instead of being shunned, the killer becomes a local hero and begins to win hearts,that is until a second man unexpectedly arrives on the scene…\")) (p \"PLAYBOY encore possibilities: Sunday 5th July PM, Sunday 26th July PM, Sunday August 2nd PM\") (figure (img :src \"https://rose-ash.com/content/images/2026/07/in-1.jpg\" :alt \"NT Live Encore?\") (figcaption \"Marquise de Merteuil is a master in the art of survival. Alongside the magnetic Vicomte de Valmont, they turn seduction into strategy and weaponise desire. But when their alliance collapses into rivalry, the battle between them threatens to destroy everyone in their path.\")) (p \"LIASONS encore possibilities: Sunday 5th July PM, Sunday 26th July PM, Sunday August 2nd PM\") (iframe :src \"https://www.youtube.com/embed/aLaRT0yAstE\") (iframe :src \"https://www.youtube.com/embed/tdlgR2FDbRI\") (iframe :src \"https://www.youtube.com/embed/wq5l5VV51sU\"))"}))) +;; a card with a FIXED slug (idempotent — seed!/set-field-values! overwrite), for demos that +;; set a composition directly. Returns the field-relative ref to store in the composition. +(define host/blog--seed-card! + (fn (container field name ctype fields) + (let ((cslug (host/blog--card-slug container field name))) + (begin + (host/blog-seed! cslug ctype "(article (h1 \"card\"))" "block") + (host/blog-relate! cslug ctype "is-a") + (host/blog--set-field-values! cslug fields) + (host/blog-relate! container cslug "contains") + (str field "__" name))))) +;; a LIVE demo of layer 2 — a Landing TYPE with TWO composition fields (:body + :aside), each +;; with its own grammar, and an instance populated in both. Idempotent (fixed slugs; overwrites). +(define host/blog-seed-landing-demo! + (fn () + (begin + (host/blog-seed! "landing" "Landing" + "(article (h1 \"Landing\") (p \"A page TYPE with two composition fields — a main :body and an :aside — each with its own block grammar. Its instances render both.\"))" + "published") + (host/blog-relate! "landing" "type" "subtype-of") + (host/blog--set-fields! "landing" + (list {:name "body" :type "Composition" + :blocks (list "card-heading" "card-text" "card-image") :allow (list "cond" "each")} + {:name "aside" :type "Composition" + :blocks (list "card-text" "card-callout") :allow (list)})) + (host/blog--set-type-relations! "landing" (list "related" "is-a" "tagged")) + (host/blog-put! "landing-demo" "Landing Demo" "(article)" "published") + (host/blog-relate! "landing-demo" "landing" "is-a") + (host/blog--set-comp! "landing-demo" "body" + (list (quote seq) + (list (quote ref) (host/blog--seed-card! "landing-demo" "body" "b0" "card-heading" {"level" "2" "text" "Welcome to the Landing Demo"})) + (list (quote ref) (host/blog--seed-card! "landing-demo" "body" "b1" "card-text" {"text" "This object has a MAIN :body composition and a separate :aside — two composition fields on one object, each edited by its own block editor and each with its own grammar."})))) + (host/blog--set-comp! "landing-demo" "aside" + (list (quote seq) + (list (quote ref) (host/blog--seed-card! "landing-demo" "aside" "a0" "card-callout" {"style" "info" "text" "This is the ASIDE composition — a second, independent field on the same object."})) + (list (quote ref) (host/blog--seed-card! "landing-demo" "aside" "a1" "card-text" {"text" "Editing the aside is CID-neutral to the body: they are separate composition fields on the record."}))))))) ;; GET /workflow-demo — run the workflow object through the execute-fold and render its ;; effect log. The same object's :body, folded by RENDER, would produce HTML; folded by ;; EXECUTE it produces this plan of effects. The behaviour model IS an execute-fold. diff --git a/lib/host/serve.sh b/lib/host/serve.sh index 1ce8fd9c..5dd1d34c 100755 --- a/lib/host/serve.sh +++ b/lib/host/serve.sh @@ -169,6 +169,11 @@ EPOCH=1 echo "(epoch $EPOCH)" echo "(eval \"(host/blog-seed-nt-live-encore!)\")" EPOCH=$((EPOCH+1)) + # Seed the layer-2 demo: a Landing type with TWO composition fields (:body + :aside) + a + # populated instance — so the two-field composition editor + render show side by side. + echo "(epoch $EPOCH)" + echo "(eval \"(host/blog-seed-landing-demo!)\")" + EPOCH=$((EPOCH+1)) # Load relation metadata (symmetry/labels) from the relation-posts into the # in-memory cache, so render paths read it without a (VmSuspending) durable read. echo "(epoch $EPOCH)" diff --git a/lib/host/tests/blog.sx b/lib/host/tests/blog.sx index 667f8893..a9e6103f 100644 --- a/lib/host/tests/blog.sx +++ b/lib/host/tests/blog.sx @@ -1062,6 +1062,20 @@ (contains? (render-page (host/blog--type-population "card")) "Subtypes") true) (host-bl-test "GET /article/ shows the Population section" (contains? (dream-resp-body (host-bl-app (host-bl-req "/article/"))) "Population") true) +;; the Landing demo: a type with TWO composition fields, an instance populated in both, +;; idempotent (re-seeding doesn't duplicate). Renders both fields; the aside forbids controls. +(host-bl-test "the landing demo seeds a 2-field type + instance (idempotent)" + (begin + (host/blog-seed-landing-demo!) (host/blog-seed-landing-demo!) ;; twice -> must not duplicate + (list (host/blog--composition-fields "landing-demo") + (len (host/blog--comp-nodes "landing-demo" "body")) + (len (host/blog--comp-nodes "landing-demo" "aside")) + (host/blog--allows-control? "landing-demo" "aside" "cond"))) + (list (list "body" "aside") 2 2 false)) +(host-bl-test "GET /landing-demo/ renders BOTH composition fields" + (let ((html (dream-resp-body (host-bl-app (host-bl-req "/landing-demo/"))))) + (list (contains? html "Welcome to the Landing Demo") (contains? html "ASIDE composition"))) + (list true true)) ;; the editor renders a HAND-AUTHORED composition (text/row/alt-with-text) WITHOUT falling ;; through to "(unknown block)" — every node kind gets a labelled row (the compose-demo case). (host-bl-test "the block editor renders text/layout/inline-alt nodes (no unknown block)"