From 536bb8b76b35478c57ace2b97640d26772d9d8ce Mon Sep 17 00:00:00 2001 From: giles Date: Tue, 30 Jun 2026 12:40:27 +0000 Subject: [PATCH] host: Slice 8c render-template-per-type + metamodel create-type form MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Closes the 'types define the UI' loop and adds the editor's create half. 8c (render template): a type declares a :template — a parameterised SX tree (stored as source) with (field "name") placeholders that resolve to the instance's field-values at render. host/blog-template-of / --set-template! / --instantiate (pure tree-walk) / --typed-block (per the post's types, parse+instantiate, pre-fetched in the handler). host/blog-post renders it above the body. Article seeded a subtitle standfirst template. So ONE field definition now drives BOTH the edit form AND the rendered page. create-type (metamodel editor surface 1): POST /meta/new-type creates a published post subtype-of "type" -> appears in host/blog-type-defs / the /meta Types list, ready to be given fields/schema/template. Guarded (unauthed -> login, not created). /meta gains a '+ Type' form. You can now DEFINE A TYPE THROUGH THE UI. Verified live-path: typed post's subtitle renders on its page; create 'Recipe' via the form -> Types(4). Blog suite 140/140. Co-Authored-By: Claude Opus 4.8 --- lib/host/blog.sx | 67 +++++++++++++++++++++++++++++++++++++++++- lib/host/tests/blog.sx | 33 +++++++++++++++++++++ 2 files changed, 99 insertions(+), 1 deletion(-) diff --git a/lib/host/blog.sx b/lib/host/blog.sx index 2d4cc891..2fad4bbd 100644 --- a/lib/host/blog.sx +++ b/lib/host/blog.sx @@ -497,6 +497,42 @@ :value (unquote val) :style "width:100%"))))))))) fields))) +;; ── Slice 8c: render TEMPLATE per type (fields drive the page, not just the form) ── +;; A type may declare a :template — a parameterised SX tree (stored as source) where +;; (field "name") placeholders resolve to the instance's field-values at render. So ONE +;; field definition drives BOTH the edit form (above) AND the rendered page. The template +;; is DATA (editable, meta-circular); a type with no template renders nothing extra. See +;; plans/relations-as-posts.md ("Types define the UI"). +(define host/blog-template-of + (fn (type-slug) (get (host/blog-get type-slug) :template))) +(define host/blog--set-template! + (fn (slug template) + (let ((r (host/blog-get slug))) + (when r (host/blog--write! slug (merge r {:template template})))))) +;; replace every (field "name") node in a parsed template tree with values[name] ("" if +;; absent). Pure: a tree-walk over the already-parsed template + pre-fetched values. +(define host/blog--instantiate + (fn (node values) + (if (and (= (type-of node) "list") (> (len node) 0)) + (if (= (str (first node)) "field") + (or (get values (first (rest node))) "") + (map (fn (c) (host/blog--instantiate c values)) node)) + node))) +;; the rendered typed block for a post: for each type it is-a that declares a :template, +;; parse + instantiate with the post's field-values. (div …) of the results, or "" if none. +;; Durable reads (types-of, template-of, field-values) — call in a handler let, not a render. +(define host/blog--typed-block + (fn (slug) + (let ((values (host/blog-field-values-of slug)) + (templates (reduce (fn (acc t) + (let ((tpl (host/blog-template-of t))) + (if tpl (concat acc (list tpl)) acc))) + (list) (host/blog-types-of slug)))) + (if (> (len templates) 0) + (cons (quote div) + (map (fn (tpl) (host/blog--instantiate (parse-safe tpl) values)) templates)) + "")))) + ;; every element tag in a parsed content tree, recursively (the heads of nested ;; lists) — so "requires h1" matches an h1 even inside an article/section wrapper. (define host/blog--all-tags @@ -576,6 +612,10 @@ (host/blog--set-fields! "article" (list {:name "subtitle" :type "String"} {:name "hero" :type "URL"})) + ;; article's render TEMPLATE (Slice 8c) — the subtitle field shown as a standfirst + ;; above the body. (field "subtitle") resolves to the instance's value at render. + (host/blog--set-template! "article" + "(p :style \"font-style:italic;color:#555;margin:0 0 1em;font-size:1.1em\" (field \"subtitle\"))") ;; relation DECLARATIONS (see plans/relations-as-posts.md). A type-post declares ;; which relation it anchors at its OBJECT end ("you may point at me with R"); the ;; picker's candidate set is the down-closure of a relation's anchors through the @@ -1014,11 +1054,15 @@ ;; all relation blocks (Related, Tags, Types, Tagged-with-this …) ;; come from iterating the registry — one section, registry-driven. (relations (host/blog--relations-or-hint slug (not (nil? principal)))) + ;; 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)) (auth-foot (host/auth-footer req))) (host/blog--resp req 200 (host/blog--page req (get r :title) (quasiquote (div + (unquote typed-block) (article (raw! (unquote body-html))) (unquote relations) (p :style "margin-top:2em;font-size:0.9em;opacity:0.8" @@ -1135,6 +1179,9 @@ (cons (quote table) (cons (quote (tr (th "Type") (th "Fields") (th "Required blocks"))) type-rows)) (quote (p "No types yet.")))) + (form :method "post" :action "/meta/new-type" :style "margin:0.5em 0 1.5em" + (input :name "title" :placeholder "New type name" :style "padding:0.3em") + " " (button :type "submit" "+ Type")) (h2 (unquote (str "Relations (" (len rel-specs) ")"))) (unquote (if (> (len rel-specs) 0) (cons (quote table) @@ -1144,6 +1191,23 @@ (a :href "/" "all posts") " · " (a :href "/tags" "tags") " · " (unquote auth-foot)))))))))) +;; POST /meta/new-type — DEFINE A TYPE THROUGH THE UI (metamodel editor, surface 1): +;; create a published post that is subtype-of "type", so it appears in host/blog-type-defs +;; / the /meta Types list and can then be given fields + a schema + a template. Guarded +;; like the other writes. Empty / already-existing title -> harmless no-op, then redirect. +(define host/blog-meta-new-type + (fn (req) + (let ((title (host/field req "title"))) + (when (and title (not (= title ""))) + (let ((slug (host/blog-slugify title))) + (begin + (when (not (host/blog-exists? slug)) + (host/blog-put! slug title + (str "(article (h1 \"" title "\") (p \"A type. Posts that is-a " title " are its instances; give it fields, a schema and a template to shape them.\"))") + "published")) + (host/blog-relate! slug "type" "subtype-of")))) + (dream-redirect "/meta")))) + ;; GET //source — the raw sx_content as text/plain. Posts ARE SX source, so ;; this just hands back the stored markup (public; a published post's source is ;; not secret). 404 if the post is absent. @@ -1402,7 +1466,8 @@ (dream-get "/:slug/edit" (host/blog--protect-html resolve host/blog-edit-form)) (dream-post "/:slug/edit" (host/blog--protect-html resolve host/blog-edit-submit)) (dream-post "/:slug/relate" (host/blog--protect-html resolve host/blog-relate-submit)) - (dream-post "/:slug/unrelate" (host/blog--protect-html resolve host/blog-unrelate-submit))))) + (dream-post "/:slug/unrelate" (host/blog--protect-html resolve host/blog-unrelate-submit)) + (dream-post "/meta/new-type" (host/blog--protect-html resolve host/blog-meta-new-type))))) ;; EXPERIMENTAL: create-only, UNGUARDED — POST /new form ingest with error ;; trapping but NO auth, for validating the editor->host publish loop on the diff --git a/lib/host/tests/blog.sx b/lib/host/tests/blog.sx index a8f7f794..1b1e82c3 100644 --- a/lib/host/tests/blog.sx +++ b/lib/host/tests/blog.sx @@ -651,6 +651,39 @@ (list (get (host/blog-field-values-of "fpost") "subtitle") (get (host/blog-field-values-of "fpost") "hero"))) (list "Saved Sub" "http://z/q.png")) + +;; -- Slice 8c: render template per type (fields drive the page too) -- +(host-bl-test "instantiate resolves (field name), replacing the placeholder" + (list (contains? (str (host/blog--instantiate (parse-safe "(p (field \"subtitle\"))") {"subtitle" "Hi"})) "Hi") + (contains? (str (host/blog--instantiate (parse-safe "(p (field \"x\"))") {})) "field")) + (list true false)) +(host-bl-test "template-of reads the article's seeded render template" + (contains? (host/blog-template-of "article") "field") true) +(host-bl-test "typed-block renders a typed post's field values" + (begin + (host/blog--set-field-values! "fpost" {"subtitle" "My Standfirst" "hero" ""}) + (contains? (str (host/blog--typed-block "fpost")) "My Standfirst")) + true) +(host-bl-test "typed-block is empty for an untyped post" + (host/blog--typed-block "hello") "") +(host-bl-test "post page renders the typed template standfirst" + (contains? (dream-resp-body (host-bl-app (host-bl-req "/fpost/"))) "My Standfirst") true) + +;; -- metamodel editor: define a type through the UI (POST /meta/new-type) -- +(host-bl-test "/meta has the create-type form" + (contains? (dream-resp-body (host-bl-app (host-bl-req "/meta"))) "/meta/new-type") true) +(host-bl-test "POST /meta/new-type creates a type (subtype-of type) in type-defs" + (begin + (host-bl-wapp (host-bl-send "POST" "/meta/new-type" "Bearer good" + "application/x-www-form-urlencoded" "title=Recipe")) + (list (host/blog-exists? "recipe") (contains? (host/blog-type-defs) "recipe"))) + (list true true)) +(host-bl-test "create-type requires auth (unauthed -> not created)" + (begin + (host-bl-wapp (host-bl-send "POST" "/meta/new-type" nil + "application/x-www-form-urlencoded" "title=Sneaky Type")) + (host/blog-exists? "sneaky-type")) + false) (host-bl-test "a post with no schema'd type is vacuously valid" (host/blog-type-valid? "ppost" "(p \"anything\")") true) (host-bl-test "edit-submit rejects content violating the type schema (not saved)"