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

host: Slice 8 — typed scalar fields on types + the generic, type-driven form

Browse Source 
The keystone: a type declares :fields [{name, value-type, widget}], an instance carries
:field-values, and the SAME edit form is generated from the type definitions — no per-type
code. 'The editor maps onto the types.'

8a (field model): host/blog-value-types (String/Text/URL/Int/Date/Bool -> default widget),
host/blog--widget-for (explicit > value-type default > text), host/blog-fields-of +
--set-fields! (on the type-post, like schema), --fields-summary. Article seeded with
subtitle:String + hero:URL. /meta gains a Fields column. host/blog-type-defs (the subtype-of
hierarchy = type DEFINITIONS, vs instances-of = is-a instances).

8b (instance form): host/blog-field-values-of + --set-field-values!; host/blog--fields-for-post
(union of the post's transitive types' fields, deduped); host/blog--field-inputs (one labelled
input per field, widget per value-type, pre-filled). edit-form injects the Fields section
(durable reads pre-fetched); edit-submit reads field-* inputs via host/field and stores them.

Verified live-path (ephemeral, SX_SERVING_JIT=1): relate is-a article -> field inputs appear
-> save -> values persist. Blog suite 132/132.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
giles
2026-06-30 12:18:34 +00:00
parent 360acbe33c
commit f5f4e93dcf
2 changed files with 155 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

111
lib/host/blog.sx
View File

@@ -416,6 +416,87 @@
(when r
(host/blog--write! slug (merge r {:schema schema}))))))
;; ── Slice 8: typed scalar FIELDS on a type (the keystone for the UI) ─
;; A type declares :fields — a list of {:name :type [:widget] [:required]} specs. A
;; field holds a typed VALUE on an instance (vs a relation, which is an edge to a post).
;; value-type names map to a default input widget; fields drive BOTH the generic edit
;; form (one input per field) AND the render template. Direct fields for now; inheritance
;; through subtype-of is a follow-up. See plans/relations-as-posts.md ("Types define the UI").
(define host/blog-value-types
{"String" {:widget "text"}
"Text" {:widget "textarea"}
"URL" {:widget "url"}
"Int" {:widget "number"}
"Date" {:widget "date"}
"Bool" {:widget "checkbox"}})
;; the input widget for a field: its explicit :widget, else its value-type's default,
;; else "text" (an unknown value-type degrades to a plain text input).
(define host/blog--widget-for
(fn (field)
(or (get field :widget)
(let ((vt (get host/blog-value-types (get field :type))))
(if vt (get vt :widget) "text")))))
;; a type-post's declared fields (empty list if none).
(define host/blog-fields-of
(fn (type-slug) (or (get (host/blog-get type-slug) :fields) (list))))
;; attach/replace a type-post's :fields (idempotent; preserves the rest of the record).
(define host/blog--set-fields!
(fn (slug fields)
(let ((r (host/blog-get slug)))
(when r
(host/blog--write! slug (merge r {:fields fields}))))))
;; "name:Type, name:Type" — a one-line summary of a field list (for /meta). "—" if none.
(define host/blog--fields-summary
(fn (fields)
(if (and fields (> (len fields) 0))
(join ", " (map (fn (f) (str (get f :name) ":" (get f :type))) fields))
"—")))
;; ── Slice 8b: field VALUES on an instance + the generic, type-driven form ──
;; An instance carries :field-values = {field-name -> value}. The fields applicable to
;; a post are the union of the fields declared by every type it is-a (deduped by name) —
;; so the SAME form is generated from the type definitions, no per-type code. This IS
;; "the editor maps onto the types": host/blog--field-inputs turns a type's fields into
;; the edit inputs; host/blog-edit-submit reads them back. Display-via-template is next.
(define host/blog-field-values-of
(fn (slug) (or (get (host/blog-get slug) :field-values) {})))
(define host/blog--set-field-values!
(fn (slug vals)
(let ((r (host/blog-get slug)))
(when r (host/blog--write! slug (merge r {:field-values vals}))))))
;; the fields applicable to a post = union over its (transitive) types' fields, deduped
;; by name. One durable graph read (types-of) up front — call in a handler let, not a render.
(define host/blog--fields-for-post
(fn (slug)
(reduce
(fn (acc t)
(reduce
(fn (a f)
(if (contains? (map (fn (g) (get g :name)) a) (get f :name))
a
(concat a (list f))))
acc
(host/blog-fields-of t)))
(list)
(host/blog-types-of slug))))
;; render one labelled input per field, pre-filled from `values`. Widget per value-type
;; (textarea for Text, else a typed <input>). Pure — takes pre-fetched fields + values.
(define host/blog--field-inputs
(fn (fields values)
(map (fn (f)
(let ((nm (get f :name)) (w (host/blog--widget-for f)))
(let ((val (or (get values nm) "")))
(quasiquote
(p (label :style "display:block;font-size:0.85em;opacity:0.7"
(unquote (str nm " (" (get f :type) ")")))
(unquote
(if (= w "textarea")
(quasiquote (textarea :name (unquote (str "field-" nm)) :rows "3"
:style "width:100%" (unquote val)))
(quasiquote (input :type (unquote w) :name (unquote (str "field-" nm))
:value (unquote val) :style "width:100%")))))))))
fields)))
;; 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
@@ -490,6 +571,11 @@
(host/blog-relate! "article" "type" "subtype-of")
;; article's schema lives ON the article post now (Slice 5) — install/migrate it.
(host/blog--set-schema! "article" (list {:block "h1" :msg "an article needs a heading (h1)"}))
;; article's typed FIELDS (Slice 8) — these drive the generic edit form + the render
;; template: a subtitle (plain text) and an optional hero image URL.
(host/blog--set-fields! "article"
(list {:name "subtitle" :type "String"}
{:name "hero" :type "URL"}))
;; 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
@@ -1016,9 +1102,9 @@
(define host/blog-meta-index
(fn (req)
(let ((type-recs
(map (fn (s) {:slug s
:title (get (host/blog-get s) :title)
:schema (host/blog-schema-of s)})
(map (fn (s)
(let ((r (host/blog-get s)))
{:slug s :title (get r :title) :schema (get r :schema) :fields (get r :fields)}))
(sort (host/blog-type-defs))))
(rel-specs host/blog-rel-kinds)
(auth-foot (host/auth-footer req)))
@@ -1027,6 +1113,7 @@
(quasiquote
(tr (td (a :href (unquote (str "/" (get p :slug) "/"))
(unquote (get p :title))))
(td (unquote (host/blog--fields-summary (get p :fields))))
(td (unquote (host/blog--schema-summary (get p :schema)))))))
type-recs))
(rel-rows
@@ -1046,7 +1133,7 @@
(h2 (unquote (str "Types (" (len type-recs) ")")))
(unquote (if (> (len type-recs) 0)
(cons (quote table)
(cons (quote (tr (th "Type") (th "Required blocks"))) type-rows))
(cons (quote (tr (th "Type") (th "Fields") (th "Required blocks"))) type-rows))
(quote (p "No types yet."))))
(h2 (unquote (str "Relations (" (len rel-specs) ")")))
(unquote (if (> (len rel-specs) 0)
@@ -1207,6 +1294,8 @@
;; here, not in the quasiquote, so IO stays in the handler body.
(let ((relation-editors (host/blog--relation-editors slug))
(tag-toggle (host/blog--is-tag-toggle slug))
(post-fields (host/blog--fields-for-post slug))
(field-values (host/blog-field-values-of slug))
(mk-opt
(fn (val label)
(if (= val status)
@@ -1223,6 +1312,11 @@
(p (textarea :name "sx_content" :rows "16"
:style "width:100%;font-family:monospace"
(unquote (or (get r :sx-content) ""))))
(unquote (if (> (len post-fields) 0)
(cons (quote div)
(cons (quote (h3 :style "font-size:1em;margin:1em 0 0.3em" "Fields"))
(host/blog--field-inputs post-fields field-values)))
""))
(p (select :name "status"
(unquote (mk-opt "draft" "Draft"))
(unquote (mk-opt "published" "Published")))
@@ -1247,7 +1341,8 @@
(quasiquote (div (h1 "404") (p (unquote (str "No post: " slug)))))))
(let ((title (or (host/field req "title") (get r :title)))
(sx-content (or (host/field req "sx_content") ""))
(status (or (host/field req "status") (get r :status))))
(status (or (host/field req "status") (get r :status)))
(post-fields (host/blog--fields-for-post slug)))
;; collect issues up front (perform): unparseable markup, then each
;; schema requirement the post's types impose. Empty = save.
(let ((issues (if (host/blog-content-ok? sx-content)
@@ -1256,6 +1351,12 @@
(if (= (len issues) 0)
(begin
(host/blog-put! slug title sx-content status)
;; store the typed field values from the generic, type-driven form (Slice 8b)
(host/blog--set-field-values! slug
(reduce (fn (acc f)
(assoc acc (get f :name)
(or (host/field req (str "field-" (get f :name))) "")))
{} post-fields))
(dream-redirect (str "/" slug "/")))
(let ((issue-items (map (fn (i) (quasiquote (li (unquote i)))) issues)))
(host/blog--resp req 400