From a8c095b1b3d986574f9fd17241c170401c6bebf1 Mon Sep 17 00:00:00 2001
From: giles <giles.bradshaw@rose-ash.com>
Date: Wed, 1 Jul 2026 11:35:29 +0000
Subject: [PATCH] =?UTF-8?q?host:=20article=20declares=20:body=20compositio?=
 =?UTF-8?q?n=20+=20decompose=20real=20posts=20(figure/iframe=E2=86=92cards?=
 =?UTF-8?q?)?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Prep for importing a real blog post into the :body composition:
- article now DECLARES {:name "body" :type "Composition"} (layer 2 — the type defines that an
  article's body is a composition). The edit FORM + submit read scalar-fields only, so the
  Composition field never gets a stray text input (or gets nil'd on save).
- decompose handles real-post block kinds: <figure> → card-image WITH its <figcaption> as the
  caption (host/blog--find-child digs out the inner <img>); <iframe>/<embed>/<video> →
  card-embed with src as :url. card-embed's template now renders an actual <iframe> (videos
  play) instead of the url as text.

blog 175/175, full host conformance 404/404 (+ test: figure→card-image(caption) & iframe→
card-embed via import). Next: wipe content (reseed types+demos), import nt-live-encore.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
---
 lib/host/blog.sx       | 33 ++++++++++++++++++++++++++-------
 lib/host/tests/blog.sx | 20 ++++++++++++++++----
 2 files changed, 42 insertions(+), 11 deletions(-)

diff --git a/lib/host/blog.sx b/lib/host/blog.sx
index 6473bfe4..a656b301 100644
--- a/lib/host/blog.sx
+++ b/lib/host/blog.sx
@@ -635,12 +635,22 @@
          (if (empty? (rest args)) "" (str (first (rest args)))))
         ((= (type-of (first args)) "keyword") (loop (rest (rest args))))
         (else (loop (rest args)))))))
+;; the first child element of `node` with tag `tag` (a list head), or nil. (For a figure's
+;; inner img / figcaption during decompose.)
+(define host/blog--find-child
+  (fn (node tag)
+    (let loop ((xs (if (= (type-of node) "list") (rest node) (list))))
+      (cond
+        ((empty? xs) nil)
+        ((and (= (type-of (first xs)) "list") (= (str (first (first xs))) tag)) (first xs))
+        (else (loop (rest xs)))))))
 ;; map an element tag to a card-type (the block vocabulary). Unknown tags -> text card.
 (define host/blog--tag->card-type
   (fn (tag)
     (cond
       ((or (= tag "h1") (= tag "h2") (= tag "h3") (= tag "h4")) "card-heading")
-      ((= tag "img") "card-image")
+      ((or (= tag "img") (= tag "figure")) "card-image")   ;; figure = image + figcaption
+      ((or (= tag "iframe") (= tag "embed") (= tag "video")) "card-embed")
       ((= tag "blockquote") "card-quote")
       ((or (= tag "pre") (= tag "code")) "card-code")
       (else "card-text"))))
@@ -650,8 +660,13 @@
     (cond
       ((= ctype "card-heading") {"level" (if (>= (len orig-tag) 2) (substr orig-tag 1) "2")
                                  "text" (host/blog--elem-text block)})
-      ((= ctype "card-image")   {"src" (host/blog--elem-attr block "src")
-                                 "alt" (host/blog--elem-attr block "alt") "caption" ""})
+      ((= ctype "card-image")
+       ;; a bare <img> (src/alt on the block) OR a <figure> (img child + a figcaption caption).
+       (let ((img (or (host/blog--find-child block "img") block))
+             (cap (host/blog--find-child block "figcaption")))
+         {"src" (host/blog--elem-attr img "src") "alt" (host/blog--elem-attr img "alt")
+          "caption" (if (nil? cap) "" (host/blog--elem-text cap))}))
+      ((= ctype "card-embed")   {"url" (host/blog--elem-attr block "src") "caption" ""})
       ((= ctype "card-code")    {"code" (host/blog--elem-text block) "language" ""})
       ((= ctype "card-quote")   {"text" (host/blog--elem-text block) "cite" ""})
       (else                     {"text" (host/blog--elem-text block)}))))
@@ -1128,7 +1143,11 @@
       ;; template: a subtitle (plain text) and an optional hero image URL.
       (host/blog--set-fields! "article"
         (list {:name "subtitle" :type "String"}
-              {:name "hero" :type "URL"}))
+              {:name "hero" :type "URL"}
+              ;; :body is a COMPOSITION field (layer 2) — an article's body is a composition of
+              ;; cards, edited by the block editor and rendered by the fold. Declaring it here
+              ;; makes the structure explicit (the default would also yield ["body"]).
+              {:name "body" :type "Composition"}))
       ;; article's render TEMPLATE (Slice 8c) — the subtitle field shown as a standfirst
       ;; above the body. (field "subtitle") resolves to the instance's value at render.
       (host/blog--set-template! "article"
@@ -1159,7 +1178,7 @@
         "(pre (code (field \"code\")))")
       (host/blog--seed-card-type! "card-embed" "Embed"
         (list {:name "url" :type "URL"} {:name "caption" :type "String"})
-        "(div :class \"embed\" (field \"url\"))")
+        "(div :class \"embed\" :style \"margin:1em 0\" (iframe :src (field \"url\") :width \"560\" :height \"315\" :frameborder \"0\" :allowfullscreen \"\" :style \"max-width:100%\"))")
       (host/blog--seed-card-type! "card-callout" "Callout"
         (list {:name "style" :type "String"} {:name "text" :type "Text"})
         "(div :class \"callout\" (field \"text\"))")
@@ -2162,7 +2181,7 @@
             (let ((relation-editors (host/blog--relation-editors slug))
                   (block-editor (host/blog--block-editors slug))
                   (tag-toggle (host/blog--is-tag-toggle slug))
-                  (post-fields (host/blog--fields-for-post slug))
+                  (post-fields (host/blog--scalar-fields slug))
                   (field-values (host/blog-field-values-of slug))
                   (mk-opt
                     (fn (val label)
@@ -2211,7 +2230,7 @@
         (let ((title (or (host/field req "title") (get r :title)))
               (sx-content (or (host/field req "sx_content") ""))
               (status (or (host/field req "status") (get r :status)))
-              (post-fields (host/blog--fields-for-post slug)))
+              (post-fields (host/blog--scalar-fields slug)))
           ;; collect issues up front (perform): unparseable markup, then each
           ;; schema requirement the post's types impose. Empty = save.
           (let ((issues (if (host/blog-content-ok? sx-content)
diff --git a/lib/host/tests/blog.sx b/lib/host/tests/blog.sx
index 163357ab..4b5860b8 100644
--- a/lib/host/tests/blog.sx
+++ b/lib/host/tests/blog.sx
@@ -612,7 +612,7 @@
 ;; -- Slice 8: typed scalar fields on a type --
 (host-bl-test "fields-of reads a type's declared fields (seeded on article)"
   (map (fn (f) (get f :name)) (host/blog-fields-of "article"))
-  (list "subtitle" "hero"))
+  (list "subtitle" "hero" "body"))
 (host-bl-test "widget-for: explicit > value-type default > text fallback"
   (list (host/blog--widget-for {:name "a" :type "URL"})
         (host/blog--widget-for {:name "b" :type "Text"})
@@ -622,9 +622,9 @@
 (host-bl-test "set-fields! is idempotent + preserves the rest of the record"
   (begin
     (host/blog--set-fields! "article"
-      (list {:name "subtitle" :type "String"} {:name "hero" :type "URL"}))
+      (list {:name "subtitle" :type "String"} {:name "hero" :type "URL"} {:name "body" :type "Composition"}))
     (list (get (host/blog-get "article") :title) (len (host/blog-fields-of "article"))))
-  (list "Article" 2))
+  (list "Article" 3))
 (host-bl-test "a type with no declared fields -> empty list"
   (host/blog-fields-of "tag") (list))
 (host-bl-test "/meta shows the article's typed fields"
@@ -636,7 +636,7 @@
     (host/blog-put! "fpost" "F Post" "(article (h1 \"F\"))" "published")
     (host/blog-relate! "fpost" "article" "is-a")
     (map (fn (f) (get f :name)) (host/blog--fields-for-post "fpost")))
-  (list "subtitle" "hero"))
+  (list "subtitle" "hero" "body"))
 (host-bl-test "a post of no typed type has no fields"
   (host/blog--fields-for-post "hello") (list))
 (host-bl-test "set/get field-values round-trips on an instance"
@@ -823,6 +823,18 @@
   (let ((html (dream-resp-body (host-bl-app (host-bl-req "/imp-x/")))))
     (list (contains? html "Heading One") (contains? html "Para text.") (contains? html "p.jpg")))
   (list true true true))
+;; real-post block kinds: a <figure> -> card-image WITH its figcaption; an <iframe> ->
+;; card-embed with its src as the url. (The nt-live-encore import shape.)
+(host-bl-test "decompose maps figure->card-image (with caption) and iframe->card-embed"
+  (begin
+    (host/blog-import-post! {"slug" "imp-fig" "title" "Fig" "status" "published"
+      "sx_content" "(article (figure (img :src \"p.jpg\" :alt \"a\") (figcaption \"the cap\")) (iframe :src \"https://youtube.com/embed/xyz\"))"})
+    (list (host/blog-is-a? "imp-fig__body__b0" "card-image")
+          (get (host/blog-field-values-of "imp-fig__body__b0") "caption")
+          (get (host/blog-field-values-of "imp-fig__body__b0") "src")
+          (host/blog-is-a? "imp-fig__body__b1" "card-embed")
+          (get (host/blog-field-values-of "imp-fig__body__b1") "url")))
+  (list true "the cap" "p.jpg" true "https://youtube.com/embed/xyz"))
 ;; -- block editor: structural edits to the post :body composition (step 6). --
 (host-bl-test "block-add! creates a card object + contains edge + appends a ref to the body"
   (begin