host: relations-as-posts slice 2 — relation metadata lives on relation-posts

is-a/subtype-of/tagged/related are now POSTS (each is-a a new `relation` root),
owning their metadata in a :rel slot {:symmetric :label :inverse-label}. The static
host/blog-rel-kinds registry is gone: kind-spec/rel-kinds/kind-symmetric? read the
relation-posts (via an in-memory cache), and the relation list derives from
host/blog-in "relation" "is-a".

Perform-budget fixes (a durable read inside the http-listen render VM raises
VmSuspended; too many per request 500s the page):
 - relation metadata is loaded into a cache at boot (host/blog-load-rel-kinds!,
   like load-edges!), so kind-spec is pure on render paths;
 - the initial edit page renders its pickers EMPTY (the load trigger fills each) —
   only the relate/unrelate FRAGMENT server-renders candidates (with-cands flag).
   Previously every edit page render did candidate-get × 4 pickers and 500'd.

host conformance 287/287 (+4 slice-2: kind-spec reads :rel, kind-symmetric? off the
post, unknown kind has no spec, rel-kinds derived from the graph). run-picker-check
3/3 (edit page boots, relate/unrelate flow works, no client errors).

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

lib/host/blog.sx

@@ -94,20 +94,25 @@
 ;; type-post, and types ARE posts (same blog:<slug> namespace).
 (define host/blog--node (fn (slug) (string->symbol (str "blog:" slug))))
 
+;; Relations are POSTS (plans/relations-as-posts.md). Each relation-post is-a
+;; `relation` and owns its metadata in a :rel slot {:symmetric :label
+;; :inverse-label}. To keep RENDER paths perform-free — a durable read inside the
+;; http-listen render VM raises VmSuspended — the relation specs are loaded into an
+;; in-memory cache at boot, exactly like edges (host/blog-load-edges!). kind-spec /
+;; rel-kinds / kind-symmetric? then read the cache (pure); the relation-posts stay
+;; the durable source of truth. host/blog-load-rel-kinds! re-reads them.
+(define host/blog--rel-cache (dict))
+(define host/blog-load-rel-kinds!
+  (fn ()
+    (for-each
+      (fn (kind)
+        (let ((m (get (host/blog-get kind) :rel)))
+          (when m (dict-set! host/blog--rel-cache kind (merge {:kind kind} m)))))
+      (host/blog-in "relation" "is-a"))))   ;; relations are flat: direct is-a is enough
+;; spec = the cached :rel metadata + :kind; nil for a non-relation (relate validates).
+(define host/blog--kind-spec (fn (kind) (get host/blog--rel-cache kind)))
 (define host/blog-rel-kinds
-  (list
+  (fn () (map (fn (k) (get host/blog--rel-cache k)) (keys host/blog--rel-cache))))
-    {:kind "related" :label "Related posts" :symmetric true :candidates "all"}
-    {:kind "is-a" :label "Types" :symmetric false :candidates "types"
-                  :inverse-label "Instances"}
-    {:kind "subtype-of" :label "Subtype of" :symmetric false :candidates "types"
-                        :inverse-label "Subtypes"}
-    {:kind "tagged" :label "Tags" :symmetric false :candidates "tags"
-                    :inverse-label "Tagged with this"}))
-
-;; registry lookup; nil for an unknown kind (relate validates against this)
-(define host/blog--kind-spec
-  (fn (kind)
-    (reduce (fn (acc k) (if (= (get k :kind) kind) k acc)) nil host/blog-rel-kinds)))
 (define host/blog--kind-symmetric?
   (fn (kind) (let ((s (host/blog--kind-spec kind))) (and s (get s :symmetric)))))
 
@@ -303,6 +308,19 @@
 (define host/blog-type-valid?
   (fn (slug content) (= (len (host/blog-type-issues slug content)) 0)))
 
+;; Seed a relation-post: a post that is-a `relation` and carries its metadata in a
+;; :rel slot. Idempotent (the record is written once; the is-a edge is a set).
+(define host/blog--seed-rel!
+  (fn (slug title symmetric label inverse-label)
+    (begin
+      (when (not (host/blog-exists? slug))
+        (persist/backend-kv-put host/blog-store (host/blog--key slug)
+          {:slug slug :title title
+           :sx-content (str "(article (h1 \"" title "\") (p \"A relation — posts link to each other through it. Its symmetry and labels live on this post.\"))")
+           :status "published"
+           :rel {:symmetric symmetric :label label :inverse-label inverse-label}}))
+      (host/blog-relate! slug "relation" "is-a"))))
+
 ;; Seed the root type-posts: "type" (the root) and "tag" (a kind of type). Types
 ;; ARE posts, so these are real posts that document themselves; tag subtype-of
 ;; type means anything that is-a tag is, transitively, a type. Idempotent — safe
@@ -310,6 +328,15 @@
 (define host/blog-seed-types!
   (fn ()
     (begin
+      ;; relations are posts too — `relation` is their root; each relation-post
+      ;; is-a relation and owns its symmetry + labels (plans/relations-as-posts.md).
+      (host/blog-seed! "relation" "Relation"
+        "(article (h1 \"Relation\") (p \"The root of relations. A relation is a typed edge between posts; each relation-post declares its symmetry and labels, and a type anchors its object end (which gives the picker its candidates).\"))"
+        "published")
+      (host/blog--seed-rel! "related"    "related"    true  "Related posts" nil)
+      (host/blog--seed-rel! "is-a"       "is a"       false "Types"         "Instances")
+      (host/blog--seed-rel! "subtype-of" "subtype of" false "Subtype of"    "Subtypes")
+      (host/blog--seed-rel! "tagged"     "tagged"     false "Tags"          "Tagged with this")
       (host/blog-seed! "type" "Type"
         "(article (h1 \"Type\") (p \"The root type. Types are posts — so this is a post that documents the idea of a type. A post declares its types with is-a edges; types form a hierarchy with subtype-of edges.\"))"
         "published")
@@ -620,30 +647,35 @@
 ;; per kind). The picker's candidates come from the kind's registry :candidates
 ;; ("all" / tags / types).
 (define host/blog--relation-editor
-  (fn (slug kind)
+  (fn (slug kind with-cands)
     ;; current edges read up front (a perform) — NOT inside the quasiquote, where
     ;; a perform would raise VmSuspended under http-listen.
     (let ((spec (host/blog--kind-spec kind))
           (current (host/blog-out slug kind))
-          ;; the results <ul>, server-rendered with the first page of candidates so a
+          ;; results <ul>. When `with-cands` (the relate/unrelate fragment), the first
-          ;; re-rendered editor's picker is never briefly empty (the load trigger then
+          ;; page of candidates is server-rendered in, so the re-rendered picker is
-          ;; re-fetches the same page and morphs it in, invisibly). Built by cons so
+          ;; never briefly empty (the load trigger then re-fetches the same page and
-          ;; the candidate li-trees splice in as children (the same pattern the current
+          ;; morphs it in, invisibly). On the INITIAL edit page it renders EMPTY and the
-          ;; list uses) — they can't be passed through a component arg (those evaluate).
+          ;; load trigger fills it — server-rendering candidates for EVERY kind's picker
+          ;; would do a durable read per candidate × every editor, blowing the
+          ;; http-listen render budget (VmSuspended). Built by cons so candidate
+          ;; li-trees splice in as children (component args would evaluate them).
           (results-ul
-            (let ((cands (take (host/blog--relate-candidates slug "" kind)
+            (let ((rows (if with-cands
-                           host/blog--picker-limit)))
+                          (let ((cands (take (host/blog--relate-candidates slug "" kind)
-              (let ((rows (append
+                                         host/blog--picker-limit)))
-                            (map (fn (p) (host/blog--picker-item slug p kind)) cands)
+                            (append
-                            (if (= (len cands) host/blog--picker-limit)
+                              (map (fn (p) (host/blog--picker-item slug p kind)) cands)
-                              (list (host/blog--picker-more slug kind "" host/blog--picker-limit))
+                              (if (= (len cands) host/blog--picker-limit)
-                              (list)))))
+                                (list (host/blog--picker-more slug kind "" host/blog--picker-limit))
-                (cons (quote ul)
+                                (list))))
-                  (append
+                          (list))))
-                    (quasiquote (:id (unquote (str "rp-" kind "-results"))
+              (cons (quote ul)
-                                 :class "rp-results"
+                (append
-                                 :style "list-style:none;padding:0;margin:0.5em 0;border:1px solid #ddd"))
+                  (quasiquote (:id (unquote (str "rp-" kind "-results"))
-                    rows))))))
+                               :class "rp-results"
+                               :style "list-style:none;padding:0;margin:0.5em 0;border:1px solid #ddd"))
+                  rows)))))
       (quasiquote
         ;; #rel-editor-KIND wraps the WHOLE editor (current list + picker) so relate
         ;; and unrelate can re-render it with one outerHTML swap — keeping the two
@@ -717,8 +749,10 @@
 (define host/blog--relation-editors
   (fn (slug)
     (cons (quote div)
-      (map (fn (spec) (host/blog--relation-editor slug (get spec :kind)))
+      ;; false: the initial edit page renders empty pickers (the load trigger fills
-        host/blog-rel-kinds))))
+      ;; each), keeping this render cheap. The relate/unrelate FRAGMENT passes true.
+      (map (fn (spec) (host/blog--relation-editor slug (get spec :kind) false))
+        (host/blog-rel-kinds)))))
 
 ;; ── read handlers ───────────────────────────────────────────────────
 ;; Post body is rendered per-block (a guarded HTML string) then injected raw.
@@ -932,7 +966,7 @@
           (begin
             (for-each (fn (o) (host/blog-unrelate! slug o kind)) (host/blog-out slug kind))
             (for-each (fn (o) (host/blog-unrelate! o slug kind)) (host/blog-in slug kind)))))
-      host/blog-rel-kinds)))
+      (host/blog-rel-kinds))))
 
 (define host/blog-delete-handler
   (fn (req)
@@ -967,7 +1001,7 @@
           ;; its candidates. text/html so the client's DOMParser swap path renders the
           ;; already-expanded fragment. Plain boosted form / no-JS still redirects.
           (if (host/blog--editor-swap-req? req)
-            (dream-html (render-page (host/blog--relation-editor slug kind)))
+            (dream-html (render-page (host/blog--relation-editor slug kind true)))
             (dream-redirect (str "/" slug "/edit"))))))))
 
 ;; POST /<slug>/unrelate — remove the relation to `other` under `kind` (default
@@ -986,7 +1020,7 @@
         ;; (re-loaded) candidate pool, and the picker is NOT cleared. A plain boosted
         ;; form (the tag toggle) or a no-JS POST still redirects + re-renders #content.
         (if (host/blog--editor-swap-req? req)
-          (dream-html (render-page (host/blog--relation-editor slug kind)))
+          (dream-html (render-page (host/blog--relation-editor slug kind true)))
           (dream-redirect (str "/" slug "/edit")))))))
 
 ;; GET /<slug>/edit — edit form pre-filled with the post's current title, raw

lib/host/serve.sh

@@ -151,6 +151,11 @@ EPOCH=1
   echo "(epoch $EPOCH)"
   echo "(eval \"(host/blog-seed-types!)\")"
   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)"
+  echo "(eval \"(host/blog-load-rel-kinds!)\")"
+  EPOCH=$((EPOCH+1))
   # Index the web-stack .sxbc by content hash so /sx/h/{hash} can serve them
   # immutably and the shell can emit the data-sx-manifest (content-addressed
   # client module cache). Done once at boot.

lib/host/tests/blog.sx

@@ -213,6 +213,11 @@
 
 ;; -- relate posts (blog × relations) --
 ;; my-first-post and another-one both exist in the write-test store at this point.
+;; Relations are posts now (their symmetry/labels live on relation-posts), so seed
+;; them up front exactly as boot does (serve.sh) before exercising relate, and load
+;; the relation metadata into the in-memory cache the same way.
+(host/blog-seed-types!)
+(host/blog-load-rel-kinds!)
 (host-bl-test "relate no auth -> redirect to login"
   (dream-status (host-bl-wapp (host-bl-send "POST" "/my-first-post/relate" nil
     "application/x-www-form-urlencoded" "other=another-one"))) 303)
@@ -276,7 +281,7 @@
 ;; "load" and on debounced "input". The SX engine re-binds these triggers on
 ;; swapped content, so it works on a full load AND a boosted SPA nav.
 (host-bl-test "picker form is declaratively wired to relate-options (load + debounced input)"
-  (let ((html (render-page (host/blog--relation-editor "alpha-post" "related"))))
+  (let ((html (render-page (host/blog--relation-editor "alpha-post" "related" true))))
     (list (contains? html "/alpha-post/relate-options")
           (contains? html "input delay:200ms, load")
           (contains? html "rp-related-results")))
@@ -285,7 +290,7 @@
 ;; <ul>, so a re-rendered editor is never briefly empty (no flash). The candidate row
 ;; for an existing post appears inside the results ul.
 (host-bl-test "editor server-renders the first page of candidates into the picker"
-  (let ((html (render-page (host/blog--relation-editor "alpha-post" "related"))))
+  (let ((html (render-page (host/blog--relation-editor "alpha-post" "related" true))))
     (list (contains? html "id=\"cand-related-")          ;; a candidate row is present
           (contains? html "Beta Post")))                 ;; an unrelated post is offered
   (list true true))
@@ -313,7 +318,7 @@
 (host/blog-relate! "alpha-post" "beta-post" "related")
 ;; the editor wraps current list + picker in #rel-editor-KIND; remove re-renders it
 (host-bl-test "relation-editor wires remove to re-render the kind's editor"
-  (let ((html (render-page (host/blog--relation-editor "alpha-post" "related"))))
+  (let ((html (render-page (host/blog--relation-editor "alpha-post" "related" true))))
     (list (contains? html "id=\"rel-editor-related\"")           ;; the swap target
           (contains? html "sx-post=\"/alpha-post/unrelate\"")    ;; AJAX, not plain post
           (contains? html "sx-target=\"#rel-editor-related\"")
@@ -481,6 +486,22 @@
   (contains? (dream-resp-body (host-bl-app (host-bl-req "/ppost/relate-options?kind=is-a"))) "Article")
   true)
 
+;; -- relations are posts: symmetry + labels read off the relation-posts (slice 2) --
+(host-bl-test "kind-spec reads :rel metadata off the relation-post"
+  (let ((s (host/blog--kind-spec "is-a")))
+    (list (get s :kind) (get s :label) (get s :symmetric) (get s :inverse-label)))
+  (list "is-a" "Types" false "Instances"))
+(host-bl-test "kind-symmetric? reads symmetry off the post (related yes, is-a no)"
+  (list (host/blog--kind-symmetric? "related") (host/blog--kind-symmetric? "is-a"))
+  (list true false))
+(host-bl-test "an unknown kind has no spec, so relate still validates it away"
+  (host/blog--kind-spec "bogus-kind") nil)
+(host-bl-test "rel-kinds is DERIVED from the graph (every post that is-a relation)"
+  (let ((kinds (map (fn (s) (get s :kind)) (host/blog-rel-kinds))))
+    (list (contains? kinds "related") (contains? kinds "is-a")
+          (contains? kinds "subtype-of") (contains? kinds "tagged")))
+  (list true true true true))
+
 ;; -- Phase 3: tags as posts --  (ocaml is-a tag, from the seed-types test above)
 (host-bl-test "is-tag?: a post that is-a tag is a tag; others are not"
   (list (host/blog-is-tag? "ocaml") (host/blog-is-tag? "ppost"))

plans/relations-as-posts.md

@@ -40,11 +40,22 @@ the relation's object-end declaration from the anchor**, which includes the root
   `host/blog--candidate-pool` to be declaration-driven. `:candidates` becomes vestigial.
 - Wrinkle fixed: the type roots now appear as `is-a` candidates.
 
-### Slice 2 — relations as first-class posts
+### Slice 2 — relations as first-class posts — DONE
-- Seed `is-a`/`subtype-of`/`tagged`/`related` as posts that own their metadata
+- `relation` root + `is-a`/`subtype-of`/`tagged`/`related` seeded as posts (each is-a
-  (`:symmetric`, `:label`, `:inverse-label`, **cardinality**, **end roles**). The registry
+  relation) owning their metadata in a `:rel` slot (`:symmetric :label :inverse-label`).
-  `host/blog-rel-kinds` melts into reads off these posts. A relation can declare its
+  `host/blog-rel-kinds` / `kind-spec` / `kind-symmetric?` now read it; the static registry
-  *subject*-end anchor too (who may be the source), not just object.
+  is gone. `host/blog--rel-slugs` = `host/blog-in "relation" "is-a"` (cheap, flat).
+- **Perform budget under http-listen (the hard lesson):** a durable read inside the
+  render VM raises `VmSuspended`, and too many per request 500s the page. Two fixes:
+  (1) relation metadata is loaded into an in-memory cache at boot (`host/blog-load-rel-kinds!`,
+  like `load-edges!`) so `kind-spec` is pure; (2) the initial edit page renders its pickers
+  EMPTY (the load trigger fills each) — only the relate/unrelate FRAGMENT server-renders
+  candidates (`with-cands` flag), so one page render doesn't do `candidate-get × every
+  picker`. Benign single-perform suspend/resume still logs `VmSuspended` but returns 200.
+- **Follow-up (Slice 2.5):** `relate-candidates` does a `host/blog-get` per pool member
+  (O(posts) for `related`). A boot-time **title cache** (updated on put!/delete!) would make
+  the picker O(1)-perform and cut the suspend/resume churn. Subject-end declarations + a
+  proper relation-subtype closure (when relations get subtyped) also belong here.
 
 ### Slice 3 — typed relations (target-type constraints)
 - A declaration carries a **target-type constraint**: the *other* end must be (an instance