host: article declares :body composition + decompose real posts (figure/iframe→cards)

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>
This commit is contained in:
2026-07-01 11:35:29 +00:00
parent 616c3cf966
commit a8c095b1b3
2 changed files with 42 additions and 11 deletions

View File

@@ -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)