From 92b8007a767666d384ed74f7cd9fd70cadbacbcf Mon Sep 17 00:00:00 2001
From: giles <giles.bradshaw@rose-ash.com>
Date: Wed, 1 Jul 2026 14:32:47 +0000
Subject: [PATCH] host: read the type definition on a type's PUBLIC page
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

A type post's public page (/article/) now shows a read-only Type-definition panel: its fields,
each Composition field's block grammar ("may contain: heading, text, image, …; control blocks:
cond, each"), and the relations its instances may use — so anyone can read what a type IS, not
just admins on the edit page. host/blog--type-def-view (the read form of host/blog--type-def-
editor's data); injected in host/blog-post after the body when host/blog--is-type?.

blog 191/191, full conformance 420/420 (+ tests: the view renders fields/grammar/relations;
GET /article/ shows it, an instance's page doesn't).

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

diff --git a/lib/host/blog.sx b/lib/host/blog.sx
index 82848e8b..6c9439fd 100644
--- a/lib/host/blog.sx
+++ b/lib/host/blog.sx
@@ -1902,6 +1902,31 @@
             (quasiquote (:id "type-def" :style "margin-top:1.5em;border-top:2px solid #999;padding-top:1em"
               (h3 :style "font-size:1em;margin:0 0 0.4em" "Type definition — what this type's instances may contain")))
             (append rows (list (host/blog--relations-form slug)))))))))
+;; the READ-ONLY type definition, shown on a type's PUBLIC page so anyone can read what the
+;; type is: its fields, each Composition field's block grammar, and the relations its instances
+;; may use. (The edit page's host/blog--type-def-editor is the writable form of the same data.)
+(define host/blog--type-def-view
+  (fn (slug)
+    (let ((fields (host/blog-fields-of slug))
+          (rels (or (host/blog--type-relations slug) (host/blog--all-rel-kinds))))
+      (let ((rows
+              (map (fn (f)
+                     (if (= (get f :type) "Composition")
+                       (let ((blocks (or (get f :blocks) (host/blog--subtype-closure (list "card") :in)))
+                             (allow (or (get f :allow) (list "cond" "each"))))
+                         (quasiquote (li
+                           (b (unquote (str (get f :name)))) " — composition; may contain "
+                           (unquote (join ", " (map host/blog--card-label blocks)))
+                           (unquote (if (empty? allow) "" (str "; control blocks: " (join ", " allow)))))))
+                       (quasiquote (li (b (unquote (str (get f :name)))) (unquote (str " : " (get f :type)))))))
+                   fields)))
+        (quasiquote
+          (aside :style "margin-top:2em;border:1px solid #ccc;background:#fafafa;padding:0.8em 1em;border-radius:4px"
+            (h3 :style "margin:0 0 0.4em;font-size:1em" "Type definition")
+            (unquote (if (> (len fields) 0)
+                       (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)))))))))
 
 ;; ── read handlers ───────────────────────────────────────────────────
 ;; Post body is rendered per-block (a guarded HTML string) then injected raw.
@@ -1929,6 +1954,9 @@
                   ;; the typed render-template block (Slice 8c) — field values shown via
                   ;; the post's types' templates. A durable read, so pre-fetch it here.
                   (typed-block (host/blog--typed-block slug))
+                  ;; 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) ""))
                   (auth-foot (host/auth-footer req)))
               (host/blog--resp req 200
                 (host/blog--page req (get r :title)
@@ -1936,6 +1964,7 @@
                     (div
                       (unquote typed-block)
                       (article (raw! (unquote body-html)))
+                      (unquote type-def-view)
                       (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 86f76ecc..779d8dec 100644
--- a/lib/host/tests/blog.sx
+++ b/lib/host/tests/blog.sx
@@ -1040,6 +1040,16 @@
     (let ((r (host/blog--type-relations "rtype")))
       (list (contains? r "related") (contains? r "tagged") (contains? r "is-a"))))
   (list true true false))
+;; the type definition is READABLE on a type's PUBLIC page (read-only view of the same data).
+(host-bl-test "the public type-def view shows fields, block grammar, and allowed relations"
+  (let ((html (render-page (host/blog--type-def-view "article"))))
+    (list (contains? html "Type definition") (contains? html "subtitle")
+          (contains? html "may contain") (contains? html "Instances may be linked by")))
+  (list true true true true))
+(host-bl-test "GET /article/ (public) shows the type definition; an instance's page does not"
+  (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))
 ;; 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)"