host: typed relations — Phase 4 cleanup, registry-driven render + /tags

Replace the hard-coded related/tagged blocks with iteration over the registry,
so adding a kind renders automatically — no handler edit.

- host/blog--relation-blocks: iterates host/blog-rel-kinds; each kind contributes
  its outgoing block (label) and, if it has an inverse, its incoming block
  (inverse-label, e.g. tagged -> "Tagged with this", is-a -> "Instances"). Empty
  blocks dropped; one kv-keys read up front, relation lookups in-memory.
  host/blog--relations-or-hint adds the logged-in "add some" hint when empty.
- host/blog--relation-editors: one editor per registry kind on the edit page
  (Related / Types / Subtype of / Tags), replacing the hard-coded two.
- GET /tags: index of every tag (a post that is-a tag), each linking its own page.
- dropped host/blog--related-block / --kind-block / --tagged-with-block (folded
  into host/blog--edges-block + the registry iteration).
- GOTCHA (4th time): host/blog-tags-index called host/blog-get INSIDE the item
  quasiquote -> VmSuspended/500 live (conformance in-memory store can't see it);
  pre-fetch records before the quasiquote.

5 tests (relations-section hint, registry render of Related+Tags, inverse block
for a tag, /tags lists + 200). 265/265; Playwright 4/4. Verified live: /tags,
post pages show registry blocks, tag page shows Types + Tagged-with-this, edit
page has a picker per kind.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>

lib/host/blog.sx

@@ -347,70 +347,71 @@
             (head (meta :charset "utf-8") (title (unquote title)))
             (body (unquote body))))))))
 
-;; "Related posts" block for the post page: a list of links when there are any;
+;; ── registry-driven relation rendering (post page) ──────────────────
-;; a subtle "add some" hint when there are none AND the viewer is logged in (an
+;; One labelled block of links from records ({:slug :title}), or "" when empty.
-;; editor); nothing for an anonymous viewer. Records (slug+title) are fetched up
+;; Records are pre-fetched, so the tree is built from in-memory data only.
-;; front so the SX tree is built from in-memory data — no durable read happens
+(define host/blog--edges-block
-;; while the page tree is rendered.
+  (fn (records label)
-(define host/blog--related-block
+    (if (> (len records) 0)
+      (let ((items (map (fn (p)
+                          (quasiquote
+                            (li (a :href (unquote (str "/" (get p :slug) "/"))
+                                  (unquote (get p :title))))))
+                     records)))
+        (quasiquote
+          (div :style "margin-top:2em"
+            (h3 (unquote label))
+            (unquote (list (quote ul) items)))))
+      "")))
+
+;; nodes -> {:slug :title} records, existence-filtered against a shared key set.
+(define host/blog--recs
+  (fn (existing nodes)
+    (map (fn (s) {:slug s :title (get (host/blog-get s) :title)})
+      (filter (fn (s) (contains? existing s))
+        (map (fn (n) (substr (symbol->string n) 5))
+          (filter (fn (n) (starts-with? (symbol->string n) "blog:")) nodes))))))
+
+;; ALL of a post's relation blocks, generated by ITERATING the registry: each
+;; kind contributes its outgoing block (label) and, if it has an inverse, its
+;; incoming block (inverse-label). Empty blocks are dropped. So adding a kind to
+;; the registry makes it render automatically — no handler edit. One kv-keys read
+;; up front; the relation lookups are in-memory. Returns a wrapper div, or "".
+(define host/blog--relation-blocks
+  (fn (slug)
+    (let ((existing (host/blog-slugs))
+          (node (host/blog--node slug)))
+      (let ((blocks
+              (reduce
+                (fn (acc spec)
+                  (let ((k (string->symbol (get spec :kind))))
+                    (let ((out-b (host/blog--edges-block
+                                   (host/blog--recs existing (relations/children node k))
+                                   (get spec :label)))
+                          (in-b (if (get spec :inverse-label)
+                                  (host/blog--edges-block
+                                    (host/blog--recs existing (relations/parents node k))
+                                    (get spec :inverse-label))
+                                  "")))
+                      (concat acc (filter (fn (b) (not (= b ""))) (list out-b in-b))))))
+                (list)
+                host/blog-rel-kinds)))
+        (if (> (len blocks) 0) (cons (quote div) blocks) "")))))
+
+;; the relation section for the post page: the blocks, or — when empty and the
+;; viewer is logged in — a subtle "add some" hint; nothing for anonymous viewers.
+(define host/blog--relations-or-hint
   (fn (slug logged-in)
-    (let ((rel (map (fn (s) {:slug s :title (get (host/blog-get s) :title)})
+    (let ((blocks (host/blog--relation-blocks slug)))
-                 (host/blog-related slug))))
       (cond
-        ((> (len rel) 0)
+        ((not (= blocks "")) blocks)
-          (let ((items
-                  (map (fn (p)
-                         (quasiquote
-                           (li (a :href (unquote (str "/" (get p :slug) "/"))
-                                 (unquote (get p :title))))))
-                    rel)))
-            (quasiquote
-              (div :style "margin-top:2em"
-                (h3 "Related posts")
-                (unquote (list (quote ul) items))))))
         (logged-in
           (quasiquote
             (p :style "margin-top:2em;font-size:0.9em;opacity:0.7"
-              "No related posts yet — "
+              "No relations yet — "
               (a :href (unquote (str "/" slug "/edit")) "add some") ".")))
         (else "")))))
 
-;; Generic "outgoing edges of a kind" block for the post page (e.g. "Tags"): a
-;; labelled list of links, or "" when empty. Records fetched up front (no durable
-;; read while the page tree is built).
-(define host/blog--kind-block
-  (fn (slug kind)
-    (let ((rel (map (fn (s) {:slug s :title (get (host/blog-get s) :title)})
-                 (host/blog-out slug kind))))
-      (if (> (len rel) 0)
-        (let ((items (map (fn (p)
-                            (quasiquote
-                              (li (a :href (unquote (str "/" (get p :slug) "/"))
-                                    (unquote (get p :title))))))
-                       rel)))
-          (quasiquote
-            (div :style "margin-top:2em"
-              (h3 (unquote (get (host/blog--kind-spec kind) :label)))
-              (unquote (list (quote ul) items)))))
-        ""))))
-
-;; "Tagged with this" — the posts tagged with this (tag) post, for a tag's page.
-(define host/blog--tagged-with-block
-  (fn (slug)
-    (let ((rel (map (fn (s) {:slug s :title (get (host/blog-get s) :title)})
-                 (host/blog-tagged-with slug))))
-      (if (> (len rel) 0)
-        (let ((items (map (fn (p)
-                            (quasiquote
-                              (li (a :href (unquote (str "/" (get p :slug) "/"))
-                                    (unquote (get p :title))))))
-                       rel)))
-          (quasiquote
-            (div :style "margin-top:2em"
-              (h3 "Tagged with this")
-              (unquote (list (quote ul) items)))))
-        ""))))
-
 ;; Kind-aware relation editor for the edit page: current links (each with a
 ;; kind-scoped remove), plus a filterable picker (a .relate-picker box the shared
 ;; /relate-picker.js wires by data-kind). The picker's candidates come from the
@@ -461,6 +462,14 @@
           (input :type "hidden" :name "kind" :value "is-a")
           (button :type "submit" "Make this a tag"))))))
 
+;; One editor per registry kind, wrapped in a div — the edit page's relation
+;; section, generated by ITERATING the registry (add a kind -> it gets an editor).
+(define host/blog--relation-editors
+  (fn (slug)
+    (cons (quote div)
+      (map (fn (spec) (host/blog--relation-editor slug (get spec :kind)))
+        host/blog-rel-kinds))))
+
 ;; ── read handlers ───────────────────────────────────────────────────
 ;; Post body is rendered per-block (a guarded HTML string) then injected raw.
 (define host/blog-post
@@ -474,20 +483,16 @@
           ;; tree is built (a perform there raises VmSuspended under http-listen).
           (let ((principal (host/current-principal req)))
             (let ((body-html (host/blog-render r))
-                  (related-block (host/blog--related-block slug (not (nil? principal))))
+                  ;; all relation blocks (Related, Tags, Types, Tagged-with-this …)
-                  (tags-block (host/blog--kind-block slug "tagged"))
+                  ;; come from iterating the registry — one section, registry-driven.
-                  ;; a tag post lists what's tagged with it (its members)
+                  (relations (host/blog--relations-or-hint slug (not (nil? principal))))
-                  (members-block (if (host/blog-is-tag? slug)
-                                   (host/blog--tagged-with-block slug) ""))
                   (auth-foot (host/auth-footer req)))
               (dream-html
                 (host/blog--page (get r :title)
                   (quasiquote
                     (div
                       (article (raw! (unquote body-html)))
-                      (unquote tags-block)
+                      (unquote relations)
-                      (unquote members-block)
-                      (unquote related-block)
                       (p :style "margin-top:2em;font-size:0.9em;opacity:0.8"
                         (a :href (unquote (str "/" slug "/source")) "view source")
                         " · "
@@ -529,6 +534,30 @@
 
 (define host/blog-index (fn (req) (host/ok (host/blog-list))))
 
+;; GET /tags — index of every tag (a post that is-a tag). Tags are posts, so each
+;; links to its own page (which documents the tag + lists what's tagged with it).
+(define host/blog-tags-index
+  (fn (req)
+    ;; pre-fetch records (slug+title) BEFORE the quasiquote — host/blog-get is a
+    ;; durable read; a perform during tree-build raises VmSuspended.
+    (let ((recs (map (fn (s) {:slug s :title (get (host/blog-get s) :title)})
+                  (sort (host/blog-instances-of "tag"))))
+          (auth-foot (host/auth-footer req)))
+      (let ((items (map (fn (p)
+                          (quasiquote
+                            (li (a :href (unquote (str "/" (get p :slug) "/"))
+                                  (unquote (get p :title))))))
+                     recs)))
+        (dream-html
+          (host/blog--page "Tags"
+            (quasiquote
+              (div (h1 "Tags")
+                (unquote (if (> (len recs) 0)
+                           (list (quote ul) items)
+                           (quote (p "No tags yet."))))
+                (p :style "margin-top:2em;font-size:0.9em;opacity:0.8"
+                  (a :href "/" "all posts") " · " (unquote auth-foot))))))))))
+
 ;; GET /<slug>/source — the raw sx_content as text/plain. Posts ARE SX source, so
 ;; this just hands back the stored markup (public; a published post's source is
 ;; not secret). 404 if the post is absent.
@@ -711,8 +740,7 @@
           (let ((status (get r :status)))
             ;; the relation editors + tag toggle do durable reads — compute them
             ;; here, not in the quasiquote, so IO stays in the handler body.
-            (let ((related-editor (host/blog--relation-editor slug "related"))
+            (let ((relation-editors (host/blog--relation-editors slug))
-                  (tags-editor (host/blog--relation-editor slug "tagged"))
                   (tag-toggle (host/blog--is-tag-toggle slug))
                   (mk-opt
                     (fn (val label)
@@ -737,8 +765,7 @@
                           (button :type "submit" "Save")))
                       (div :style "margin-top:2em;border-top:1px solid #ccc;padding-top:1em"
                         (unquote tag-toggle))
-                      (unquote related-editor)
+                      (unquote relation-editors)
-                      (unquote tags-editor)
                       ;; one shared picker script wires every .relate-picker box
                       (raw! "<script src=\"/relate-picker.js\"></script>")
                       (p :style "margin-top:1.5em"
@@ -779,6 +806,7 @@
     (dream-get "/" host/blog-home)
     (dream-get "/posts" host/blog-index)
     (dream-get "/new" host/blog-new-form)
+    (dream-get "/tags" host/blog-tags-index)
     (dream-get "/relate-picker.js" host/blog-picker-js)
     (dream-get "/:slug/source" host/blog-source)
     (dream-get "/:slug/relate-options" host/blog-relate-options)

lib/host/tests/blog.sx

@@ -276,10 +276,11 @@
   "application/javascript; charset=utf-8")
 (host-bl-test "relate-picker.js carries the fetch glue"
   (contains? (dream-resp-body (host-bl-app (host-bl-req "/relate-picker.js"))) "relate-options") true)
-(host-bl-test "related block: hint when logged-in + no relations"
+(host/blog-put! "hint-post" "Hint Post" "(p \"h\")" "published")
-  (contains? (str (host/blog--related-block "gamma-post" true)) "add some") true)
+(host-bl-test "relations section: hint when logged-in + no relations"
-(host-bl-test "related block: empty when anonymous + no relations"
+  (contains? (str (host/blog--relations-or-hint "hint-post" true)) "add some") true)
-  (= (host/blog--related-block "gamma-post" false) "") true)
+(host-bl-test "relations section: empty when anonymous + no relations"
+  (= (host/blog--relations-or-hint "hint-post" false) "") true)
 
 ;; -- Phase 1: relations carry a kind --
 (host-bl-test "symmetric kind (related) reads from both sides"
@@ -395,6 +396,21 @@
     (host/blog-is-tag? "pdoc"))
   true)
 
+;; -- Phase 4: registry-driven render + /tags index --
+(host-bl-test "relation-blocks renders Related + Tags from the registry"
+  (begin
+    (host/blog-relate! "hint-post" "ppost" "related")
+    (host/blog-relate! "hint-post" "ocaml" "tagged")
+    (let ((body (str (host/blog--relation-blocks "hint-post"))))
+      (list (contains? body "Related posts") (contains? body "Tags"))))
+  (list true true))
+(host-bl-test "relation-blocks shows an inverse block (Tagged with this) for a tag"
+  (contains? (str (host/blog--relation-blocks "ocaml")) "Tagged with this") true)
+(host-bl-test "/tags lists the tag posts"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/tags"))) "OCaml") true)
+(host-bl-test "/tags is 200 (not shadowed by /:slug)"
+  (dream-status (host-bl-app (host-bl-req "/tags"))) 200)
+
 ;; -- experimental unguarded create-only route (POST /new, no auth) --
 (define host-bl-oapp (host/make-app (list host/blog-open-create-routes host/blog-routes)))
 (host/blog-use-store! (persist/open))