host: Part C — edit the TYPE DEFINITION (its grammar) on the type's own page
"It's just more composition": a type post's edit page now shows a Type-definition editor —
each field as name:type, and each Composition field with a GRAMMAR CHECKLIST (a checkbox per
card kind = permitted, + conditional/repeater toggles). Editing it changes what the type's
instances may contain. host/blog--{is-type?, set-field-grammar!, own-field, checkbox,
grammar-form, type-def-editor}; POST /<type>/grammar reads the checklist (uniquely-named
blk-<ct> / allow-<ctrl> boxes, since form fields are single-value) → set-field-grammar!.
Shown only when host/blog--is-type? (declares fields, or subtype-of type) — a type's page has
it, an instance's doesn't.
blog 184/184, full conformance 413/413 (+ Part C tests: is-type?, set-field-grammar!, the
checklist renders, POST /grammar sets it, appears on a type page not an instance's).
Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
@@ -536,6 +536,28 @@
|
||||
(concat acc (list (str "‘" k "’ blocks are not allowed in :" field)))))
|
||||
(else acc))))
|
||||
(list) (host/blog--comp-nodes slug field))))
|
||||
;; ── Part C: the TYPE DEFINITION is itself editable — a type's :fields (each with, for a
|
||||
;; Composition field, its block grammar) are displayed + edited on the type's own edit page.
|
||||
;; is this post a TYPE? (declares fields, or is subtype-of "type" transitively). --
|
||||
(define host/blog--is-type?
|
||||
(fn (slug)
|
||||
(or (> (len (host/blog-fields-of slug)) 0)
|
||||
(contains? (host/blog--subtype-closure (host/blog-out slug "subtype-of") :out) "type"))))
|
||||
;; set a Composition field's grammar (:blocks + :allow) on a type, preserving its other fields.
|
||||
(define host/blog--set-field-grammar!
|
||||
(fn (slug fname blocks allow)
|
||||
(host/blog--set-fields! slug
|
||||
(map (fn (f) (if (= (str (get f :name)) fname) (merge f {:blocks blocks :allow allow}) f))
|
||||
(host/blog-fields-of slug)))))
|
||||
;; a labelled checkbox (the attr must be OMITTED when unchecked — an empty :checked still
|
||||
;; checks the box).
|
||||
(define host/blog--checkbox
|
||||
(fn (name label checked)
|
||||
(if checked
|
||||
(quasiquote (label :style "margin-right:0.9em;white-space:nowrap"
|
||||
(input :type "checkbox" :name (unquote name) :checked "checked") " " (unquote label)))
|
||||
(quasiquote (label :style "margin-right:0.9em;white-space:nowrap"
|
||||
(input :type "checkbox" :name (unquote name)) " " (unquote label))))))
|
||||
;; 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
|
||||
@@ -1792,6 +1814,56 @@
|
||||
(unquote (cons (quote div)
|
||||
(map (fn (f) (host/blog--block-editor slug f)) (host/blog--composition-fields slug))))))))
|
||||
|
||||
;; ── Part C: the TYPE-DEFINITION editor (shown when editing a TYPE post). "It's just more
|
||||
;; composition" — a type's :fields are displayed, and each Composition field's grammar (which
|
||||
;; card kinds + control blocks it permits) is edited with a checklist. The type governs what
|
||||
;; its instances' compositions can contain; here you edit that governance. --
|
||||
(define host/blog--own-field
|
||||
(fn (slug fname)
|
||||
(let loop ((fs (host/blog-fields-of slug)))
|
||||
(cond ((empty? fs) nil) ((= (str (get (first fs) :name)) fname) (first fs)) (else (loop (rest fs)))))))
|
||||
;; the grammar edit form for ONE Composition field (id #grammar-<field>): a checkbox per card
|
||||
;; type (checked = permitted) + conditional/repeater toggles, POSTing to /<slug>/grammar.
|
||||
(define host/blog--grammar-form
|
||||
(fn (slug fdecl)
|
||||
(let ((fname (str (get fdecl :name)))
|
||||
(cur (or (get fdecl :blocks) (host/blog--subtype-closure (list "card") :in)))
|
||||
(ctrl (or (get fdecl :allow) (list "cond" "each")))
|
||||
(all-cards (host/blog--subtype-closure (list "card") :in))
|
||||
(url (str "/" slug "/grammar")))
|
||||
(let ((tgt (str "#grammar-" fname))
|
||||
(card-checks (map (fn (ct) (host/blog--checkbox (str "blk-" ct) (host/blog--card-label ct) (contains? cur ct))) all-cards)))
|
||||
(cons (quote form)
|
||||
(append
|
||||
(quasiquote (:method "post" :action (unquote url) :sx-post (unquote url)
|
||||
:sx-target (unquote tgt) :sx-swap "outerHTML"
|
||||
:id (unquote (str "grammar-" fname))
|
||||
:style "margin:0.3em 0;padding:0.5em;border:1px dashed #bbb"
|
||||
(input :type "hidden" :name "field" :value (unquote fname))
|
||||
(div :style "font-weight:bold;font-size:0.9em;margin-bottom:0.3em"
|
||||
(unquote (str ":" fname " may contain these blocks —")))))
|
||||
(append card-checks
|
||||
(quasiquote ((br)
|
||||
(unquote (host/blog--checkbox "allow-cond" "conditional (or)" (contains? ctrl "cond")))
|
||||
(unquote (host/blog--checkbox "allow-each" "repeater (each)" (contains? ctrl "each")))
|
||||
(br) (button :type "submit" :style "margin-top:0.4em" "save grammar"))))))))))
|
||||
;; the whole type-definition editor: a row per field (scalar shown as name:type; Composition
|
||||
;; shown with its grammar form).
|
||||
(define host/blog--type-def-editor
|
||||
(fn (slug)
|
||||
(let ((fields (host/blog-fields-of slug)))
|
||||
(let ((rows (map (fn (f)
|
||||
(if (= (get f :type) "Composition")
|
||||
(host/blog--grammar-form slug f)
|
||||
(quasiquote (div :style "padding:0.15em 0;color:#555"
|
||||
(b (unquote (str (get f :name)))) (unquote (str " : " (get f :type)))))))
|
||||
fields)))
|
||||
(cons (quote div)
|
||||
(append
|
||||
(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")))
|
||||
rows))))))
|
||||
|
||||
;; ── read handlers ───────────────────────────────────────────────────
|
||||
;; Post body is rendered per-block (a guarded HTML string) then injected raw.
|
||||
(define host/blog-post
|
||||
@@ -2226,6 +2298,20 @@
|
||||
(let ((slug (dream-param req "slug")) (field (host/blog--block-field req)) (ckey (or (host/field req "cond") "auth")))
|
||||
(begin (when (host/blog-exists? slug) (host/blog-block-set-cond! slug field (host/blog--block-idx req) ckey))
|
||||
(host/blog--block-resp req slug field)))))
|
||||
;; POST /<type>/grammar — set a Composition field's block grammar from the checklist. Only on a
|
||||
;; TYPE post (it defines what its instances' compositions may contain).
|
||||
(define host/blog-grammar-submit
|
||||
(fn (req)
|
||||
(let ((slug (dream-param req "slug")) (fname (or (host/field req "field") "body")))
|
||||
(begin
|
||||
(when (and (host/blog-exists? slug) (host/blog--is-type? slug))
|
||||
(let ((all-cards (host/blog--subtype-closure (list "card") :in)))
|
||||
(host/blog--set-field-grammar! slug fname
|
||||
(filter (fn (ct) (not (nil? (host/field req (str "blk-" ct))))) all-cards)
|
||||
(filter (fn (c) (not (nil? (host/field req (str "allow-" c))))) (list "cond" "each")))))
|
||||
(if (host/blog--editor-swap-req? req)
|
||||
(dream-html (render-page (host/blog--grammar-form slug (host/blog--own-field slug fname))))
|
||||
(dream-redirect (str "/" slug "/edit")))))))
|
||||
|
||||
;; GET /<slug>/edit — edit form pre-filled with the post's current title, raw
|
||||
;; sx_content (in a textarea — render-to-html escapes the text child, so the
|
||||
@@ -2244,6 +2330,8 @@
|
||||
;; here, not in the quasiquote, so IO stays in the handler body.
|
||||
(let ((relation-editors (host/blog--relation-editors slug))
|
||||
(block-editor (host/blog--block-editors slug))
|
||||
;; if this post is a TYPE, its definition (fields + grammar) is editable here.
|
||||
(type-def (if (host/blog--is-type? slug) (host/blog--type-def-editor slug) ""))
|
||||
(tag-toggle (host/blog--is-tag-toggle slug))
|
||||
(post-fields (host/blog--scalar-fields slug))
|
||||
(field-values (host/blog-field-values-of slug))
|
||||
@@ -2275,6 +2363,7 @@
|
||||
(button :type "submit" "Save")))
|
||||
(div :style "margin-top:2em;border-top:1px solid #ccc;padding-top:1em"
|
||||
(unquote tag-toggle))
|
||||
(unquote type-def)
|
||||
(unquote block-editor)
|
||||
(unquote relation-editors)
|
||||
(p :style "margin-top:1.5em"
|
||||
@@ -2360,6 +2449,7 @@
|
||||
(dream-post "/:slug/blocks/:idx/remove" (host/blog--protect-html resolve host/blog-block-remove-submit))
|
||||
(dream-post "/:slug/blocks/:idx/move" (host/blog--protect-html resolve host/blog-block-move-submit))
|
||||
(dream-post "/:slug/blocks/:idx/cond" (host/blog--protect-html resolve host/blog-block-cond-submit))
|
||||
(dream-post "/:slug/grammar" (host/blog--protect-html resolve host/blog-grammar-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 "/meta/new-type" (host/blog--protect-html resolve host/blog-meta-new-type))
|
||||
|
||||
Reference in New Issue
Block a user