host: Part A — type-block GRAMMAR (a Composition field declares which blocks it permits)
The type now GOVERNS the composition, not just declares the slot. A Composition field carries
its grammar: {:name "body" :type "Composition" :blocks (…card types…) :allow ("cond" "each")}.
:blocks absent -> any card subtype (back-compat); :allow absent -> both control blocks.
- host/blog--{field-decl, allowed-blocks, allows-control?, block-allowed?, comp-violations}.
- The editor PALETTE is the grammar: one <option> per allowed card type (spliced as direct
<select> children), and the conditional/repeater add-forms appear only if :allow permits.
- block-add-submit ENFORCES it (was a coarse "any card subtype" check) — the type governs writes.
- comp-violations flags a composition holding a forbidden block (the save/import gate).
- article declares its :body grammar (all 7 card kinds + cond/each).
blog 179/179, full conformance 408/408 (+ grammar tests: allowed-blocks/allows-control?,
palette shows only permitted kinds, add rejects a forbidden card, violations flags one).
Part B (relations as type-governed composition) + Part C (edit the type definition) next.
Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
@@ -934,6 +934,43 @@
|
||||
(host-bl-test "composition-fields defaults to [body] when the type declares none"
|
||||
(begin (host/blog-put! "plain1" "P" "(p)" "published") (host/blog--composition-fields "plain1"))
|
||||
(list "body"))
|
||||
;; -- LAYER 2b: type-block GRAMMAR — a Composition field declares which block kinds it PERMITS.
|
||||
;; The type governs the composition: editor palette + add + validation all read the grammar. --
|
||||
(host-bl-test "allowed-blocks + allows-control? read the field's grammar (:blocks / :allow)"
|
||||
(begin
|
||||
(host/blog-seed! "grmtype" "G" "(p)" "published")
|
||||
(host/blog-relate! "grmtype" "type" "subtype-of")
|
||||
(host/blog--set-fields! "grmtype"
|
||||
(list {:name "body" :type "Composition" :blocks (list "card-text" "card-heading") :allow (list "cond")}))
|
||||
(host/blog-put! "grm1" "G1" "(article)" "published")
|
||||
(host/blog-relate! "grm1" "grmtype" "is-a")
|
||||
(list (host/blog--allowed-blocks "grm1" "body")
|
||||
(host/blog--block-allowed? "grm1" "body" "card-text") (host/blog--block-allowed? "grm1" "body" "card-image")
|
||||
(host/blog--allows-control? "grm1" "body" "cond") (host/blog--allows-control? "grm1" "body" "each")))
|
||||
(list (list "card-text" "card-heading") true false true false))
|
||||
;; the editor PALETTE is the grammar — only the allowed card types + permitted control blocks.
|
||||
(host-bl-test "the block editor palette shows only the grammar's card kinds + allowed controls"
|
||||
(let ((html (render-page (host/blog--block-editor "grm1" "body"))))
|
||||
(list (contains? html "value=\"card-text\"") (contains? html "value=\"card-heading\"")
|
||||
(contains? html "value=\"card-image\"") (contains? html "+ conditional") (contains? html "+ repeater")))
|
||||
(list true true false true false))
|
||||
;; the add handler REJECTS a card kind outside the grammar (the type governs writes).
|
||||
(host-bl-test "block-add-submit rejects a card kind the grammar forbids"
|
||||
(begin
|
||||
(host/blog--set-body! "grm1" (quote (seq)))
|
||||
(host-bl-wapp (host-bl-send "POST" "/grm1/blocks/add" "Bearer good"
|
||||
"application/x-www-form-urlencoded" "field=body&ctype=card-image&text=x"))
|
||||
(list (len (host/blog--comp-nodes "grm1" "body")) ;; image rejected -> 0
|
||||
(begin (host-bl-wapp (host-bl-send "POST" "/grm1/blocks/add" "Bearer good"
|
||||
"application/x-www-form-urlencoded" "field=body&ctype=card-text&text=ok"))
|
||||
(len (host/blog--comp-nodes "grm1" "body"))))) ;; text allowed -> 1
|
||||
(list 0 1))
|
||||
;; validation flags a composition holding a block the grammar forbids (import/save gate).
|
||||
(host-bl-test "comp-violations flags a card kind outside the field's grammar"
|
||||
(begin
|
||||
(host/blog-block-add! "grm1" "body" "card-image" {"src" "x.jpg"}) ;; model add bypasses the handler guard
|
||||
(> (len (host/blog--comp-violations "grm1" "body")) 0))
|
||||
true)
|
||||
;; 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)"
|
||||
|
||||
Reference in New Issue
Block a user