coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

host: read the type definition on a type's PUBLIC page

Browse Source 
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>
This commit is contained in:
giles
2026-07-01 14:32:47 +00:00
parent 7838e45aea
commit 92b8007a76
2 changed files with 39 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

29
lib/host/blog.sx
View File

@@ -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")