From fc7ec990370bb1e2d87e43b21fc12d28af1f3d07 Mon Sep 17 00:00:00 2001
From: giles <giles.bradshaw@rose-ash.com>
Date: Wed, 1 Jul 2026 15:17:51 +0000
Subject: [PATCH] =?UTF-8?q?host:=20type=20pages=20are=20self-documenting?=
 =?UTF-8?q?=20=E2=80=94=20definition=20+=20POPULATION?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Every type post reads as schema + extension. Added host/blog--type-population (host/blog--take
helper): a type's page shows its instances (posts is-a it, first 24 + count) and its subtypes
(is-a / subtype-of inverses), next to the read-only type definition. Injected in host/blog-post
when host/blog--is-type?. So /article/ shows what an article IS *and* which posts are articles;
/card/ shows its subtypes; every card type / tag / type reads its own definition (all are
is-type?).

blog 194/194 (+ tests: population lists instances + count, a parent type lists subtypes, GET
/article/ shows Population).

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
---
 lib/host/blog.sx       | 25 +++++++++++++++++++++++++
 lib/host/tests/blog.sx | 12 ++++++++++++
 2 files changed, 37 insertions(+)

diff --git a/lib/host/blog.sx b/lib/host/blog.sx
index 6c9439fd..8f7c5f6f 100644
--- a/lib/host/blog.sx
+++ b/lib/host/blog.sx
@@ -1927,6 +1927,29 @@
                        (cons (quote ul) (append (quasiquote (:style "margin:0.3em 0")) rows))
                        (quote (p :style "color:#999;margin:0" "No declared fields."))))
             (p :style "margin:0.4em 0 0" (b "Instances may be linked by: ") (unquote (join ", " rels)))))))))
+;; the first n elements of a list.
+(define host/blog--take
+  (fn (xs n) (let loop ((ys xs) (k n) (acc (list)))
+    (if (or (empty? ys) (<= k 0)) acc (loop (rest ys) (- k 1) (concat acc (list (first ys))))))))
+;; a type's POPULATION — its instances (posts is-a this type) + subtypes — shown on the type's
+;; public page next to its definition (schema + extension). Durable reads: call in a handler.
+(define host/blog--type-population
+  (fn (slug)
+    (let ((instances (host/blog-in slug "is-a"))
+          (subtypes (host/blog-in slug "subtype-of")))
+      (let ((inst-links (map (fn (s) (quasiquote (li (a :href (unquote (str "/" s "/")) (unquote s)))))
+                             (host/blog--take instances 24))))
+        (quasiquote
+          (aside :style "margin-top:1em;border:1px solid #ccc;background:#fafafa;padding:0.8em 1em;border-radius:4px"
+            (h3 :style "margin:0 0 0.4em;font-size:1em"
+              (unquote (str "Population — " (len instances) " instance" (if (= (len instances) 1) "" "s"))))
+            (unquote (if (> (len subtypes) 0)
+                       (quasiquote (p :style "margin:0.2em 0" (b "Subtypes: ") (unquote (join ", " subtypes))))
+                       ""))
+            (unquote (if (> (len instances) 0)
+                       (cons (quote ul) (append (quasiquote (:style "margin:0.3em 0")) inst-links))
+                       (quote (p :style "color:#999;margin:0" "No instances yet."))))
+            (unquote (if (> (len instances) 24) (quote (p :style "color:#999;margin:0" "… (showing first 24)")) ""))))))))
 
 ;; ── read handlers ───────────────────────────────────────────────────
 ;; Post body is rendered per-block (a guarded HTML string) then injected raw.
@@ -1957,6 +1980,7 @@
                   ;; a TYPE post shows its definition (fields + grammar + relations) publicly —
                   ;; read-only; the edit page has the writable form.
                   (type-def-view (if (host/blog--is-type? slug) (host/blog--type-def-view slug) ""))
+                  (type-population (if (host/blog--is-type? slug) (host/blog--type-population slug) ""))
                   (auth-foot (host/auth-footer req)))
               (host/blog--resp req 200
                 (host/blog--page req (get r :title)
@@ -1965,6 +1989,7 @@
                       (unquote typed-block)
                       (article (raw! (unquote body-html)))
                       (unquote type-def-view)
+                      (unquote type-population)
                       (unquote relations)
                       (p :style "margin-top:2em;font-size:0.9em;opacity:0.8"
                         (a :href (unquote (str "/" slug "/source")) "view source")
diff --git a/lib/host/tests/blog.sx b/lib/host/tests/blog.sx
index 779d8dec..667f8893 100644
--- a/lib/host/tests/blog.sx
+++ b/lib/host/tests/blog.sx
@@ -1050,6 +1050,18 @@
   (list (contains? (dream-resp-body (host-bl-app (host-bl-req "/article/"))) "Type definition")
         (contains? (dream-resp-body (host-bl-app (host-bl-req "/my-first-post/"))) "Type definition"))
   (list true false))
+;; a type's page shows its POPULATION too — instances (is-a) + subtypes (schema + extension).
+(host-bl-test "the type-population section lists a type's instances + count"
+  (begin
+    (host/blog-put! "pop-inst" "PopInst" "(article (h1 \"x\"))" "published")
+    (host/blog-relate! "pop-inst" "article" "is-a")
+    (let ((html (render-page (host/blog--type-population "article"))))
+      (list (contains? html "Population") (contains? html "pop-inst") (contains? html "instance"))))
+  (list true true true))
+(host-bl-test "a parent type's population lists its subtypes"
+  (contains? (render-page (host/blog--type-population "card")) "Subtypes") true)
+(host-bl-test "GET /article/ shows the Population section"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/article/"))) "Population") true)
 ;; the editor renders a HAND-AUTHORED composition (text/row/alt-with-text) WITHOUT falling
 ;; through to "(unknown block)" — every node kind gets a labelled row (the compose-demo case).
 (host-bl-test "the block editor renders text/layout/inline-alt nodes (no unknown block)"