host: typed relations — Phase 1, generalize edges to carry a kind

Plan: plans/typed-posts-and-relations.md. "Typing is just relating to a type",
types are posts. Phase 1 lifts the hard-coded kind:"related" into a parameter,
driven by one registry — the spine the later phases (type resolution, tags,
picker) build on. Zero user-visible change.

- host/blog-rel-kinds registry: {kind,label,symmetric,candidates[,inverse-label]}
  for related (symmetric) / is-a / tagged (directed). One place knows each kind's
  direction, label, and candidate set.
- host/blog-relate!/unrelate! take a kind; symmetric kinds write both directions,
  directed kinds write one. host/blog-out/in read children/parents per kind;
  host/blog-related = out(slug,"related") (back-compat).
- relate/unrelate routes carry a `kind` form field (default "related"), validated
  against the registry. delete drops edges across ALL kinds + both directions.

6 tests: symmetric reads both sides, directed writes one (inverse via host/blog-in),
unrelate is kind-scoped, unknown kind rejected, default kind = related. 244/244;
Playwright picker 4/4 (related path unchanged).

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

lib/host/blog.sx

@@ -85,35 +85,68 @@
             (else (host/blog--render-node tree))))
         (str "<p>(empty post)</p>")))))
 ;; ── related posts (blog × relations) ────────────────────────────────
-;; A "related" link between two posts is a SYMMETRIC pair of edges in the
-;; relations graph (lib/relations): node = "blog:<slug>", kind = related. Edges go
-;; both ways so "related posts" reads the same from either side via children alone
-;; — composing two already-migrated domains (blog + relations) on the host.
-(define host/blog--rel-kind (string->symbol "related"))
+;; Every link between posts is a typed edge in the relations graph (lib/relations):
+;; node = "blog:<slug>", kind = a relation kind. "related" is symmetric; directed
+;; kinds (is-a, tagged) carry meaning by direction. The registry below is the one
+;; place that knows each kind's direction, label, and candidate set — relate, the
+;; picker, and rendering all read from it (see plans/typed-posts-and-relations.md).
+;; "Typing is just relating to a type": classification is an is-a/tagged edge to a
+;; type-post, and types ARE posts (same blog:<slug> namespace).
 (define host/blog--node (fn (slug) (string->symbol (str "blog:" slug))))
 
-(define host/blog-relate!
-  (fn (a b)
-    (begin
-      (relations/relate (host/blog--node a) (host/blog--node b) host/blog--rel-kind)
-      (relations/relate (host/blog--node b) (host/blog--node a) host/blog--rel-kind))))
-(define host/blog-unrelate!
-  (fn (a b)
-    (begin
-      (relations/unrelate (host/blog--node a) (host/blog--node b) host/blog--rel-kind)
-      (relations/unrelate (host/blog--node b) (host/blog--node a) host/blog--rel-kind))))
+(define host/blog-rel-kinds
+  (list
+    {:kind "related" :label "Related posts" :symmetric true :candidates "all"}
+    {:kind "is-a" :label "Types" :symmetric false :candidates "types"
+                  :inverse-label "Instances"}
+    {:kind "tagged" :label "Tags" :symmetric false :candidates "tags"
+                    :inverse-label "Tagged with this"}))
 
-;; related slugs for a post: blog children under "related", stripped to slug, and
-;; limited to posts that still exist (a deleted post can leave a dangling edge).
-;; Existence is checked against ONE kv-keys read (host/blog-slugs), not a perform
-;; per candidate — keeping IO out of the inner filter.
-(define host/blog-related
-  (fn (slug)
+;; 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)))))
+
+;; ── edges (parameterised by kind) ───────────────────────────────────
+;; A symmetric kind writes both directions, so children alone read it from either
+;; side; a directed kind writes one edge (the inverse is host/blog-in).
+(define host/blog-relate!
+  (fn (a b kind)
+    (let ((k (string->symbol kind)))
+      (begin
+        (relations/relate (host/blog--node a) (host/blog--node b) k)
+        (when (host/blog--kind-symmetric? kind)
+          (relations/relate (host/blog--node b) (host/blog--node a) k))))))
+(define host/blog-unrelate!
+  (fn (a b kind)
+    (let ((k (string->symbol kind)))
+      (begin
+        (relations/unrelate (host/blog--node a) (host/blog--node b) k)
+        (when (host/blog--kind-symmetric? kind)
+          (relations/unrelate (host/blog--node b) (host/blog--node a) k))))))
+
+;; nodes -> existing blog slugs: strip "blog:", drop non-blog and deleted targets.
+;; Existence is one kv-keys read (host/blog-slugs), NOT a perform per candidate —
+;; keeping IO out of the inner filter (and out of the page-render quasiquote).
+(define host/blog--edge-slugs
+  (fn (nodes)
     (let ((existing (host/blog-slugs)))
-      (let ((kids (relations/children (host/blog--node slug) host/blog--rel-kind)))
-        (filter (fn (s) (contains? existing s))
-          (map (fn (n) (substr (symbol->string n) 5))
-            (filter (fn (n) (starts-with? (symbol->string n) "blog:")) kids)))))))
+      (filter (fn (s) (contains? existing s))
+        (map (fn (n) (substr (symbol->string n) 5))
+          (filter (fn (n) (starts-with? (symbol->string n) "blog:")) nodes))))))
+
+;; outgoing targets / incoming sources of `slug` under `kind`, as slug lists.
+(define host/blog-out
+  (fn (slug kind)
+    (host/blog--edge-slugs (relations/children (host/blog--node slug) (string->symbol kind)))))
+(define host/blog-in
+  (fn (slug kind)
+    (host/blog--edge-slugs (relations/parents (host/blog--node slug) (string->symbol kind)))))
+
+;; back-compat: "related posts" is just the symmetric "related" kind.
+(define host/blog-related (fn (slug) (host/blog-out slug "related")))
 
 ;; ── relate picker (filterable, paginated candidate list) ────────────
 ;; Candidates to relate `slug` to: every post except itself and ones already
@@ -421,42 +454,57 @@
         (host/error 400 "invalid payload")))))
 
 ;; DELETE /posts/<slug>
+;; drop every edge touching `slug`, across all kinds + both directions, so a
+;; deleted post leaves no dangling links anywhere in the graph.
+(define host/blog--drop-all-edges!
+  (fn (slug)
+    (for-each
+      (fn (spec)
+        (let ((kind (get spec :kind)))
+          (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)))
+
 (define host/blog-delete-handler
   (fn (req)
     (let ((slug (dream-param req "slug")))
       (if (host/blog-exists? slug)
         (begin
-          ;; drop the post's related edges so no dangling links survive it
-          (for-each (fn (o) (host/blog-unrelate! slug o)) (host/blog-related slug))
+          (host/blog--drop-all-edges! slug)
           (host/blog-delete! slug)
           (host/ok {:slug slug :deleted true}))
         (host/error 404 "no such post")))))
 
-;; POST /<slug>/relate — relate this post to another (form field `other` = slug).
-;; Validated: the other post must exist and differ; otherwise it's a no-op. Always
-;; redirects back to the edit page. Guarded like the other browser write routes.
+;; POST /<slug>/relate — relate this post to another (form `other` = slug, `kind` =
+;; relation kind, default "related"). Validated: kind must be a known kind and the
+;; other post must exist and differ; otherwise a no-op. Redirects back to the edit
+;; page. Guarded like the other browser write routes.
 (define host/blog-relate-submit
   (fn (req)
     (let ((slug (dream-param req "slug"))
-          (other (dream-form-field req "other")))
+          (other (dream-form-field req "other"))
+          (kind (or (dream-form-field req "kind") "related")))
       (if (nil? (host/blog-get slug))
         (dream-html-status 404
           (host/blog--page "Not found"
             (quasiquote (div (h1 "404") (p (unquote (str "No post: " slug)))))))
         (begin
-          (when (and other (not (= other "")) (not (= other slug)) (host/blog-exists? other))
-            (host/blog-relate! slug other))
+          (when (and other (not (= other "")) (not (= other slug))
+                     (host/blog--kind-spec kind) (host/blog-exists? other))
+            (host/blog-relate! slug other kind))
           (dream-redirect (str "/" slug "/edit")))))))
 
-;; POST /<slug>/unrelate — remove the relation to `other`. Idempotent; redirects
-;; back to the edit page.
+;; POST /<slug>/unrelate — remove the relation to `other` under `kind` (default
+;; "related"). Idempotent; redirects back to the edit page.
 (define host/blog-unrelate-submit
   (fn (req)
     (let ((slug (dream-param req "slug"))
-          (other (dream-form-field req "other")))
+          (other (dream-form-field req "other"))
+          (kind (or (dream-form-field req "kind") "related")))
       (begin
-        (when (and other (not (= other "")))
-          (host/blog-unrelate! slug other))
+        (when (and other (not (= other "")) (host/blog--kind-spec kind))
+          (host/blog-unrelate! slug other kind))
         (dream-redirect (str "/" slug "/edit"))))))
 
 ;; GET /<slug>/edit — edit form pre-filled with the post's current title, raw