;; lib/host/blog.sx — Blog domain on the host, on the EDITOR's content model.
;; The SX post editor (blog/sx/editor.sx) emits `sx_content`: SX element markup
;; (e.g. "(article (h1 \"T\") (p \"body\" (strong \"x\")))"), NOT content-on-sx
;; CtDoc blocks. So a post here is a record {slug,title,sx_content,status} stored
;; in the durable persist KV, and a post page is `render-to-html (parse sx_content)`
;; — server-side, static, no client runtime needed to view a published post.
;;
;;   GET    /              HTML index of posts (public)
;;   GET    /<slug>/       rendered post (public) -> HTML / 404
;;   GET    /posts         SX list (public)       -> {:ok true :data ({:slug …} …)}
;;   GET    /new           HTML create form (public chrome)
;;   POST   /new           form ingest from the editor (guarded)
;;   POST   /<slug>/edit   form ingest, edit an existing post (guarded)
;; Reads anonymous; writes behind the auth+ACL pipeline ("edit" on "blog"). The
;; JSON CRUD /posts (POST/PUT/DELETE) was deleted in the SX-native pivot — the wire
;; is SX/SXTP (host/ok emits text/sx), writes go through the form ingest.
;; Depends on spec/render + web/adapter-html (render-to-html), lib/persist/*
;; (durable KV), lib/dream/* (+ form), lib/host/{handler,middleware}.sx.

;; ── store (durable persist KV, injectable) ──────────────────────────
(define host/blog-store (persist/open))
(define host/blog-use-store! (fn (b) (set! host/blog-store b)))
(define host/blog--key (fn (slug) (str "blog:" slug)))

;; ── content-addressing: a universal CID over the canonical form ─────
;; Every object (content/type/relation/constraint post) carries a stable :cid =
;; hash of its CONTENT. The runtime has no hash primitive, so the canon serializer
;; and a tail-recursive double-hash are built here. Canon SORTS keys, so the CID is
;; identical across processes regardless of dict insertion / hash-seed order. The
;; :slug (a mutable name) and any prior :cid are excluded — the CID hashes content
;; only. git-shaped: slug = mutable name -> CID = immutable content identity.
(define host/blog--canon
  (fn (v)
    (let ((t (type-of v)))
      (cond
        ((= t "dict")
          (str "{" (join "|"
            (map (fn (k) (str k "=" (host/blog--canon (get v k))))
              (filter (fn (k) (and (not (= k "slug")) (not (= k "cid"))))
                (sort (keys v))))) "}"))
        ((= t "list") (str "[" (join "|" (map host/blog--canon v)) "]"))
        ((= t "nil") "~")
        (else (str v))))))
(define host/blog--hash-go
  (fn (s i n h1 h2)
    (if (>= i n)
      (str h1 "-" h2)
      (let ((c (char-code (substr s i 1))))
        (host/blog--hash-go s (+ i 1) n
          (mod (+ (* h1 131) c) 1000000007)
          (mod (+ (* h2 137) c) 998244353))))))
(define host/blog--cid-of
  (fn (rec) (let ((s (host/blog--canon rec))) (str "z" (host/blog--hash-go s 0 (len s) 7 11)))))
;; the single choke point for every record write: stamps the content CID, then puts.
(define host/blog--write!
  (fn (slug rec)
    (persist/backend-kv-put host/blog-store (host/blog--key slug)
      (merge rec {:cid (host/blog--cid-of rec)}))))

;; slug from a title: lowercase, words joined by '-'. (Punctuation kept simple.)
(define host/blog-slugify
  (fn (title)
    (join "-" (filter (fn (w) (not (= w ""))) (split (lower title) " ")))))

;; ── records ─────────────────────────────────────────────────────────
(define host/blog-get
  (fn (slug) (persist/backend-kv-get host/blog-store (host/blog--key slug))))
(define host/blog-exists?
  (fn (slug) (persist/backend-kv-has? host/blog-store (host/blog--key slug))))
;; A write preserves any extra slots already on the record (:rel for relation-posts,
;; :schema for refinement types) — merging over the previous record — so editing a
;; post's title/content/status doesn't nuke the metadata that lives alongside it.
(define host/blog-put!
  (fn (slug title sx-content status)
    (let ((prev (host/blog-get slug)))
      (host/blog--write! slug
        (merge (if prev prev {})
          {:slug slug :title title :sx-content sx-content :status status})))))
(define host/blog-delete!
  (fn (slug) (persist/backend-kv-delete host/blog-store (host/blog--key slug))))
(define host/blog-seed!
  (fn (slug title sx-content status)
    (when (not (host/blog-exists? slug)) (host/blog-put! slug title sx-content status))))

;; all blog slugs (kv keys are "blog:<slug>")
(define host/blog-slugs
  (fn ()
    (reduce
      (fn (acc k)
        (if (starts-with? k "blog:") (append acc (list (substr k 5))) acc))
      (list)
      (persist/backend-kv-keys host/blog-store))))
(define host/blog-list
  (fn ()
    (map
      (fn (slug)
        (let ((r (host/blog-get slug)))
          {:slug slug :title (get r :title) :status (get r :status)}))
      (host/blog-slugs))))

;; a post's content CID — its global, location-independent identity (nil if unknown).
(define host/blog-cid (fn (slug) (get (host/blog-get slug) :cid)))
;; reverse lookup: a slug whose record has this CID (nil if none). Scan; not for renders.
(define host/blog-by-cid
  (fn (cid)
    (reduce
      (fn (acc slug) (if acc acc (if (= (host/blog-cid slug) cid) slug acc)))
      nil (host/blog-slugs))))

;; ── render ──────────────────────────────────────────────────────────
;; A post's sx_content is SX element markup -> HTML via render-page (which supplies
;; the server env so components resolve + keyword attrs are kept).
;;
;; Rendered PER BLOCK and guarded: the editor wraps content in a (<> ...) fragment
;; of blocks, some of which the host can't render (the legacy editor emits bare
;; ~kg-md cards while the components are ~kg_cards/kg-md — drift we don't paper over
;; with aliases). Rendering each block under its own guard means the real prose
;; (p/h1/ul/...) shows and only the unsupported block degrades to a placeholder —
;; and a bad block never crashes the handler (-> 502).
(define host/blog--render-node
  (fn (node)
    (guard (e (true "<div class=\"blk-unsupported\"><em>(unsupported block)</em></div>"))
      (render-page node))))
(define host/blog-render
  (fn (record)
    (let ((sx (get record :sx-content)))
      (if (and sx (not (= sx "")))
        (let ((tree (parse-safe sx)))
          (cond
            ((nil? tree) "<p><em>(unparseable content)</em></p>")
            ((and (= (type-of tree) "list") (> (len tree) 0)
                  (= (str (first tree)) "<>"))
              (join "" (map host/blog--render-node (rest tree))))
            (else (host/blog--render-node tree))))
        (str "<p>(empty post)</p>")))))
;; ── related posts (blog × relations) ────────────────────────────────
;; Every link between posts is a typed edge in the relations graph (lib/relations):
;; node = "blog:<slug>", kind = a relation kind. "related" is symmetric; directed
;; kinds (is-a, tagged) carry meaning by direction. The registry below is the one
;; place that knows each kind's direction, label, and candidate set — relate, the
;; picker, and rendering all read from it (see plans/typed-posts-and-relations.md).
;; "Typing is just relating to a type": classification is an is-a/tagged edge to a
;; type-post, and types ARE posts (same blog:<slug> namespace).
(define host/blog--node (fn (slug) (string->symbol (str "blog:" slug))))

;; Relations are POSTS (plans/relations-as-posts.md). Each relation-post is-a
;; `relation` and owns its metadata in a :rel slot {:symmetric :label
;; :inverse-label}. To keep RENDER paths perform-free — a durable read inside the
;; http-listen render VM raises VmSuspended — the relation specs are loaded into an
;; in-memory cache at boot, exactly like edges (host/blog-load-edges!). kind-spec /
;; rel-kinds / kind-symmetric? then read the cache (pure); the relation-posts stay
;; the durable source of truth. host/blog-load-rel-kinds! re-reads them.
(define host/blog--rel-cache (dict))
;; cache one relation-post's :rel metadata (+ :kind), keyed by slug.
(define host/blog--cache-rel!
  (fn (kind)
    (let ((m (get (host/blog-get kind) :rel)))
      (when m (dict-set! host/blog--rel-cache kind (merge {:kind kind} m))))))
;; host/blog-rel-kinds is a VALUE (the list of relation specs), populated at boot by
;; load-rel-kinds! — like slice 1's static registry, which mapped fine on the live
;; serving JIT. (Computing it as a function that map/for-each-es a function-produced
;; list silently lost 3 of 4 relations on the live JIT — see plans/relations-as-posts.md
;; / plans/jit-bytecode-correctness.md. Both the cache loads and the list build are
;; therefore UNROLLED — no iteration over the relation list.) Metadata still lives on
;; the relation-posts; add a relation = a seed-rel! + a line in each unrolled list.
(define host/blog-rel-kinds (list))
;; UNROLLED, and it must STAY unrolled: load-rel-kinds! runs at BOOT, where it is
;; JIT-compiled but the http-listen IO resolver is NOT yet installed (that happens when
;; serving starts). The serving-JIT HO-callback-perform fix (81177d0e) only engages WITH
;; the resolver, so a dynamic loader (map/for-each/reduce over instances-of "relation"
;; with a durable read per item) silently returns [] at boot — verified 2026-06-30:
;; dynamic loader -> /meta Relations(0). So the cache loads + the list are UNROLLED (no
;; HO over a function-produced list). A new relation is a seed-rel! + a line here; or
;; appended at RUNTIME (where the resolver IS installed) — see host/blog-meta-new-relation.
(define host/blog-load-rel-kinds!
  (fn ()
    (begin
      (host/blog--cache-rel! "related")
      (host/blog--cache-rel! "is-a")
      (host/blog--cache-rel! "subtype-of")
      (host/blog--cache-rel! "tagged")
      (set! host/blog-rel-kinds
        (list (get host/blog--rel-cache "related") (get host/blog--rel-cache "is-a")
              (get host/blog--rel-cache "subtype-of") (get host/blog--rel-cache "tagged"))))))
;; spec = the cached :rel metadata + :kind; nil for a non-relation (relate validates).
(define host/blog--kind-spec (fn (kind) (get host/blog--rel-cache kind)))
(define host/blog--kind-symmetric?
  (fn (kind) (let ((s (host/blog--kind-spec kind))) (and s (get s :symmetric)))))

;; ── edges (parameterised by kind, DURABLE) ──────────────────────────
;; lib/relations holds the graph in memory (a Datalog cache that re-saturates per
;; query); it does NOT survive a restart. So the host owns the durable source of
;; truth: every physical edge is also a KV row "edge:<src>|<kind>|<dst>" in the
;; blog store, replayed into the in-memory graph on boot (host/blog-load-edges!).
;; '|' is a safe delimiter — slugs are [a-z0-9-], kinds are registry names.
(define host/blog--edge-key (fn (src kind dst) (str "edge:" src "|" kind "|" dst)))

(define host/blog--add-edge!
  (fn (src dst kind)
    (begin
      (relations/relate (host/blog--node src) (host/blog--node dst) (string->symbol kind))
      (persist/backend-kv-put host/blog-store (host/blog--edge-key src kind dst) 1))))
(define host/blog--del-edge!
  (fn (src dst kind)
    (begin
      (relations/unrelate (host/blog--node src) (host/blog--node dst) (string->symbol kind))
      (persist/backend-kv-delete host/blog-store (host/blog--edge-key src kind dst)))))

;; A symmetric kind writes both directions, so children alone read it from either
;; side; a directed kind writes one edge (the inverse is host/blog-in).
(define host/blog-relate!
  (fn (a b kind)
    (begin
      (host/blog--add-edge! a b kind)
      (when (host/blog--kind-symmetric? kind) (host/blog--add-edge! b a kind)))))
(define host/blog-unrelate!
  (fn (a b kind)
    (begin
      (host/blog--del-edge! a b kind)
      (when (host/blog--kind-symmetric? kind) (host/blog--del-edge! b a kind)))))

;; rebuild the in-memory graph from the durable edge store — called on boot, after
;; the store is pointed at the durable backend. Each "edge:<src>|<kind>|<dst>" key
;; is re-applied directly (both directions of a symmetric kind are stored, so no
;; symmetry re-derivation is needed here).
(define host/blog-load-edges!
  (fn ()
    (for-each
      (fn (key)
        (let ((body (substr key 5)))                 ;; drop "edge:"
          (let ((p1 (index-of body "|")))
            (when (>= p1 0)
              (let ((src (substr body 0 p1))
                    (tail (substr body (+ p1 1))))
                (let ((p2 (index-of tail "|")))
                  (when (>= p2 0)
                    (let ((ek (substr tail 0 p2)))
                      ;; conj/disj are structural (type-algebra operands) — KV-only,
                      ;; never replayed into the Datalog graph (it re-saturates per query).
                      (when (not (or (= ek "conj") (= ek "disj")))
                        (relations/relate
                          (host/blog--node src)
                          (host/blog--node (substr tail (+ p2 1)))
                          (string->symbol ek)))))))))))
      (filter (fn (k) (starts-with? k "edge:"))
        (persist/backend-kv-keys host/blog-store)))))

;; nodes -> existing blog slugs: strip "blog:", drop non-blog and deleted targets.
;; Existence is one kv-keys read (host/blog-slugs), NOT a perform per candidate —
;; keeping IO out of the inner filter (and out of the page-render quasiquote).
(define host/blog--edge-slugs
  (fn (nodes)
    (let ((existing (host/blog-slugs)))
      (filter (fn (s) (contains? existing s))
        (map (fn (n) (substr (symbol->string n) 5))
          (filter (fn (n) (starts-with? (symbol->string n) "blog:")) nodes))))))

;; DIRECT edges come from the durable edge store, NOT lib/relations: each relations
;; query re-runs the (CEK-interpreted) ruleset — ~seconds even on a tiny graph —
;; whereas the edge:<src>|<kind>|<dst> KV rows are a cheap string scan. lib/relations
;; is reserved for TRANSITIVE queries (descendants/ancestors). The two are always
;; in sync: host/blog-relate! writes both, and a plain blog edge has no derived
;; effective edges, so KV == relations/children for direct lookups.
(define host/blog--parse-edge-key
  (fn (k)
    (if (starts-with? k "edge:")
      (let ((body (substr k 5)))
        (let ((p1 (index-of body "|")))
          (if (< p1 0) nil
            (let ((rest (substr body (+ p1 1))))
              (let ((p2 (index-of rest "|")))
                (if (< p2 0) nil
                  {:src (substr body 0 p1)
                   :kind (substr rest 0 p2)
                   :dst (substr rest (+ p2 1))}))))))
      nil)))
(define host/blog--all-edges
  (fn ()
    (filter (fn (e) (not (nil? e)))
      (map host/blog--parse-edge-key (persist/backend-kv-keys host/blog-store)))))

;; outgoing targets / incoming sources of `slug` under `kind`, as existing slugs.
(define host/blog-out
  (fn (slug kind)
    (let ((existing (host/blog-slugs)))
      (filter (fn (s) (contains? existing s))
        (reduce (fn (acc e)
                  (if (and (= (get e :src) slug) (= (get e :kind) kind))
                    (concat acc (list (get e :dst))) acc))
          (list) (host/blog--all-edges))))))
(define host/blog-in
  (fn (slug kind)
    (let ((existing (host/blog-slugs)))
      (filter (fn (s) (contains? existing s))
        (reduce (fn (acc e)
                  (if (and (= (get e :dst) slug) (= (get e :kind) kind))
                    (concat acc (list (get e :src))) acc))
          (list) (host/blog--all-edges))))))

;; back-compat: "related posts" is just the symmetric "related" kind.
(define host/blog-related (fn (slug) (host/blog-out slug "related")))

;; ── typing: is-a + subtype-of with subsumption ──────────────────────
;; Typing is just relating to a type, and types ARE posts. A post DECLARES its
;; types with is-a edges; types form a hierarchy with subtype-of edges. is-a
;; (instance-of) is NOT transitive on its own, but subsumption is: an instance of
;; a subtype is an instance of the supertype. So a post's full type set is its
;; declared types PLUS every subtype-of-ancestor of each (relations/descendants
;; follows subtype-of transitively). Keeps the Datalog ruleset minimal — the
;; closure is composed host-side.
(define host/blog--uniq
  (fn (xs) (reduce (fn (acc x) (if (contains? acc x) acc (concat acc (list x)))) (list) xs)))

(define host/blog-types-of
  (fn (slug)
    (host/blog--uniq
      (reduce
        (fn (acc t)
          (concat (concat acc (list t))
            (host/blog--edge-slugs
              (relations/descendants (host/blog--node t) (string->symbol "subtype-of")))))
        (list)
        (host/blog-out slug "is-a")))))

;; is this post (transitively) of the given type-slug?
(define host/blog-is-a? (fn (slug type) (contains? (host/blog-types-of slug) type)))

;; all posts that are (transitively) instances of `type`: instances of the type
;; itself plus instances of any of its subtypes. Computed in O(#subtypes) relation
;; queries, NOT one type-resolution per post — the efficient way to enumerate a
;; type's members (e.g. "all tags") for the picker.
(define host/blog-instances-of
  (fn (type)
    (let ((subtypes
            (concat (list type)
              (host/blog--edge-slugs
                (relations/ancestors (host/blog--node type) (string->symbol "subtype-of"))))))
      (host/blog--uniq
        (reduce (fn (acc t) (concat acc (host/blog-in t "is-a"))) (list) subtypes)))))

;; All type-posts: the subtype-of hierarchy rooted at "type" (type + its transitive
;; subtypes). This is "the types you've DEFINED" — distinct from host/blog-instances-of
;; "type" (which is the is-a INSTANCES of the type, i.e. typed content, not the type
;; definitions; the definitions are linked by subtype-of, the same set instances-of
;; computes internally as `subtypes`). Used by the metamodel overview + editor.
(define host/blog-type-defs
  (fn ()
    (host/blog--uniq
      (concat (list "type")
        (host/blog--edge-slugs
          (relations/ancestors (host/blog--node "type") (string->symbol "subtype-of")))))))

;; ── Slice 4: type ALGEBRA — intersection (∧) and union (∨) types ─────
;; An algebraic type is a post with operand edges: a `conj` edge per intersection
;; member, a `disj` edge per union member. Its EXTENT is its operands' extents combined
;; by set intersection / union, recursively — so types compose into an algebra in the
;; same graph (meta-circular: an algebraic type is just another post). Binary today
;; (nth 0/1, no fold over operands — robust on the serving JIT); n-ary is a follow-up.
;; is-a-expr? generalises is-a? to type expressions.
(define host/blog--set-intersect
  (fn (xs ys) (filter (fn (x) (contains? ys x)) xs)))
;; operand edges live in the KV ONLY (read back via host/blog-out), NOT in lib/relations:
;; conj/disj are structural, and feeding extra kinds into the Datalog graph blows up its
;; per-query re-saturation. host/blog-load-edges! skips them on replay for the same reason.
(define host/blog--add-edge-kv!
  (fn (src dst kind)
    (persist/backend-kv-put host/blog-store (host/blog--edge-key src kind dst) 1)))
(define host/blog-make-and!
  (fn (t a b)
    (begin
      (host/blog-seed! t t
        (str "(article (h1 \"" t "\") (p \"An intersection type (" a " ∧ " b ") — its instances are exactly those that are instances of BOTH.\"))")
        "published")
      (host/blog--add-edge-kv! t a "conj")
      (host/blog--add-edge-kv! t b "conj"))))
(define host/blog-make-or!
  (fn (t a b)
    (begin
      (host/blog-seed! t t
        (str "(article (h1 \"" t "\") (p \"A union type (" a " ∨ " b ") — its instances are those that are instances of EITHER.\"))")
        "published")
      (host/blog--add-edge-kv! t a "disj")
      (host/blog--add-edge-kv! t b "disj"))))
;; the EXTENT of a type expression: operands' extents combined by set ops (recursive).
;; A plain type (no operands) falls through to its instances.
(define host/blog-instances-of-expr
  (fn (t)
    (let ((conj (host/blog-out t "conj"))
          (disj (host/blog-out t "disj")))
      (cond
        ((>= (len conj) 2)
          (host/blog--set-intersect (host/blog-instances-of-expr (nth conj 0))
                                    (host/blog-instances-of-expr (nth conj 1))))
        ((>= (len disj) 2)
          (host/blog--uniq (concat (host/blog-instances-of-expr (nth disj 0))
                                   (host/blog-instances-of-expr (nth disj 1)))))
        (else (host/blog-instances-of t))))))
;; is `slug` a member of the type expression `t`? Generalises is-a? to the algebra.
(define host/blog-is-a-expr?
  (fn (slug t) (contains? (host/blog-instances-of-expr t) slug)))

;; ── tags (a tag is a post that is-a tag) ────────────────────────────
(define host/blog-is-tag? (fn (slug) (host/blog-is-a? slug "tag")))
(define host/blog-tags (fn (slug) (host/blog-out slug "tagged")))          ;; a post's tags
(define host/blog-tagged-with (fn (tag) (host/blog-in tag "tagged")))      ;; posts with a tag

;; ── gradual validation: refinement types (schemas ON the type-post) ──
;; A type-post may carry a SCHEMA in a :schema slot: a list of rules
;; {:block <tag> :msg <why>}, each requiring the content to contain (anywhere) an
;; element of that tag — i.e. a refinement type {x : T | x has these blocks}. A post
;; is checked against the schema of every type it is-a; a type with no schema imposes
;; nothing (gradual). Schemas are declarative data (not opaque predicates), so they
;; yield a specific, human error AND live on the type-post (Slice 5) — make a new
;; refinement type by giving its post a :schema (host/blog--set-schema!).
;; schema-of reads the type-post; only the SAVE path calls it (a write request, where
;; a durable read is fine — never in a render, which would VmSuspend).
(define host/blog-schema-of (fn (type-slug) (get (host/blog-get type-slug) :schema)))
;; attach/replace a type-post's :schema (idempotent; preserves the rest of the record).
;; Used at boot to install schemas on type-posts — incl. migrating ones seeded before
;; schemas lived on the post (a single read+write, not a loop, so boot-JIT-safe).
(define host/blog--set-schema!
  (fn (slug schema)
    (let ((r (host/blog-get slug)))
      (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)))

;; ── 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
  (fn (tree)
    (if (and (= (type-of tree) "list") (> (len tree) 0))
      (concat (list (str (first tree)))
        (reduce (fn (acc c) (concat acc (host/blog--all-tags c))) (list) (rest tree)))
      (list))))

;; the :msg of each required :block a schema asks for but the content lacks.
(define host/blog--schema-issues
  (fn (schema content)
    (let ((tags (host/blog--all-tags (parse-safe content))))
      (reduce
        (fn (acc rule)
          (if (contains? tags (get rule :block)) acc (concat acc (list (get rule :msg)))))
        (list) schema))))

;; all schema issues for a post = the union over every type it is-a that carries a
;; schema. Empty = valid; vacuous (and cheap) when no type has a schema.
(define host/blog-type-issues
  (fn (slug content)
    (reduce
      (fn (acc t)
        (let ((s (host/blog-schema-of t)))
          (if s (concat acc (host/blog--schema-issues s content)) acc)))
      (list) (host/blog-types-of slug))))
(define host/blog-type-valid?
  (fn (slug content) (= (len (host/blog-type-issues slug content)) 0)))

;; Seed a relation-post: a post that is-a `relation` and carries its metadata in a
;; :rel slot. Idempotent (the record is written once; the is-a edge is a set).
(define host/blog--seed-rel!
  (fn (slug title symmetric label inverse-label)
    (begin
      (when (not (host/blog-exists? slug))
        (host/blog--write! slug
          {:slug slug :title title
           :sx-content (str "(article (h1 \"" title "\") (p \"A relation — posts link to each other through it. Its symmetry and labels live on this post.\"))")
           :status "published"
           :rel {:symmetric symmetric :label label :inverse-label inverse-label}}))
      (host/blog-relate! slug "relation" "is-a"))))

;; Seed the root type-posts: "type" (the root) and "tag" (a kind of type). Types
;; ARE posts, so these are real posts that document themselves; tag subtype-of
;; type means anything that is-a tag is, transitively, a type. Idempotent — safe
;; to call on every boot (host/blog-seed! no-ops if present, edges are sets).
(define host/blog-seed-types!
  (fn ()
    (begin
      ;; relations are posts too — `relation` is their root; each relation-post
      ;; is-a relation and owns its symmetry + labels (plans/relations-as-posts.md).
      (host/blog-seed! "relation" "Relation"
        "(article (h1 \"Relation\") (p \"The root of relations. A relation is a typed edge between posts; each relation-post declares its symmetry and labels, and a type anchors its object end (which gives the picker its candidates).\"))"
        "published")
      (host/blog--seed-rel! "related"    "related"    true  "Related posts" nil)
      (host/blog--seed-rel! "is-a"       "is a"       false "Types"         "Instances")
      (host/blog--seed-rel! "subtype-of" "subtype of" false "Subtype of"    "Subtypes")
      (host/blog--seed-rel! "tagged"     "tagged"     false "Tags"          "Tagged with this")
      (host/blog-seed! "type" "Type"
        "(article (h1 \"Type\") (p \"The root type. Types are posts — so this is a post that documents the idea of a type. A post declares its types with is-a edges; types form a hierarchy with subtype-of edges.\"))"
        "published")
      (host/blog-seed! "tag" "Tag"
        "(article (h1 \"Tag\") (p \"A tag is a kind of type (tag subtype-of type), so anything that is-a tag is also a type. A post is tagged with a tag; a tag post documents the tag and lists what is tagged with it.\"))"
        "published")
      (host/blog-relate! "tag" "type" "subtype-of")
      ;; "article" — a type WITH a schema (requires a heading). Posts that is-a
      ;; article are validated against it on save (gradual typing in action).
      (host/blog-seed! "article" "Article"
        "(article (h1 \"Article\") (p \"A kind of post that must have a heading. A post that is-a article is checked against this type's schema on save — gradual typing: declaring the type adds the requirement, and the next edit must satisfy it.\"))"
        "published")
      (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"}))
      ;; 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
      ;; type graph, so the candidates for a relation are exactly the posts that inherit
      ;; its declaration. `type` anchors is-a + subtype-of (you point at a type), `tag`
      ;; anchors tagged (you point at a tag). `related` has no anchor → every post.
      (host/blog-relate! "type" "is-a" "declares")
      (host/blog-relate! "type" "subtype-of" "declares")
      (host/blog-relate! "tag" "tagged" "declares"))))

;; ── relate picker (filterable, paginated candidate list) ────────────
;; Candidates to relate `slug` to: every post except itself and ones already
;; related, narrowed by `q` (case-insensitive substring of title or slug),
;; title-sorted. One page is `host/blog--picker-limit` rows from `offset`.
(define host/blog--picker-limit 20)
;; Down-closure: every post reachable from `roots` by walking INVERSE is-a ∪
;; subtype-of edges (i.e. instances and subtypes, transitively), roots included.
;; This is "everything that is, transitively, an instance-or-subtype of a root".
;; BFS over direct edges (host/blog-in); `seen` makes it cycle-safe and terminating.
(define host/blog--reach-down
  (fn (roots)
    (let loop ((frontier roots) (seen (list)))
      (if (empty? frontier)
        seen
        (let ((t (first frontier)))
          (if (contains? seen t)
            (loop (rest frontier) seen)
            (loop
              (concat (rest frontier)
                (concat (host/blog-in t "is-a") (host/blog-in t "subtype-of")))
              (concat seen (list t)))))))))

;; The candidate POOL for relating under `kind` is DECLARATION-driven (see
;; plans/relations-as-posts.md): the down-closure of the posts that DECLARE `kind`
;; at their object end. So is-a/subtype-of (anchored by `type`) offer the whole type
;; closure — roots AND instances — and `tagged` (anchored by `tag`) offers the tags.
;; A relation with no declaration (e.g. `related`) offers every post.
(define host/blog--candidate-pool
  (fn (kind)
    (let ((anchors (host/blog-in kind "declares")))
      (if (empty? anchors)
        (host/blog-slugs)
        (host/blog--reach-down anchors)))))

;; Slice 3 — typed relations: a post is a valid OBJECT (target end) of `kind` iff it's
;; in the relation's declared candidate set (the down-closure of kind's declares-anchors
;; — the target-type constraint). The SAME set the picker offers, so the picker and
;; the relate endpoint agree by construction. A relation with no anchor (`related`)
;; accepts any existing post. This is what turns "candidate set" into an enforced
;; relation schema: is-a's object must be a type, tagged's must be a tag, etc.
(define host/blog--valid-object?
  (fn (kind other)
    (contains? (host/blog--candidate-pool kind) other)))

(define host/blog--title (fn (s) (get (host/blog-get s) :title)))   ;; one durable read

;; One PAGE of candidates (records {:slug :title}) for relating `slug` under `kind`.
;; Slice 2.5 — title reads are O(page), not O(pool): the available candidate SLUGS are
;; computed + slug-sorted with NO per-candidate read; then titles are fetched only for
;; the rows actually returned. On the unfiltered path (q="" — the initial picker load
;; AND every editor server-fill) that's ~`limit` reads instead of one-per-post, which
;; was the durable-read churn under http-listen. A filter (q≠"") still resolves titles
;; across the pool, since it matches on the title — but that's the interactive path.
(define host/blog--relate-candidates
  (fn (slug q kind offset limit)
    (let ((pool (host/blog--candidate-pool kind))
          (already (host/blog-out slug kind))
          (ql (lower (or q ""))))
      (let ((avail (sort (filter (fn (s) (and (not (= s slug)) (not (contains? already s)))) pool))))
        (if (= ql "")
          ;; no filter: page by slug, then read titles for just the page
          (map (fn (s) {:slug s :title (host/blog--title s)})
            (take (drop avail offset) limit))
          ;; filter: resolve titles, match on title|slug, then page
          (let ((recs (map (fn (s) {:slug s :title (host/blog--title s)}) avail)))
            (take
              (drop
                (filter (fn (r) (or (contains? (lower (get r :title)) ql)
                                    (contains? (get r :slug) ql)))
                  recs)
                offset)
              limit)))))))

;; One candidate row: a tiny form whose button adds the relation under `kind`.
(define host/blog--picker-item
  (fn (slug p kind)
    (quasiquote
      (li :id (unquote (str "cand-" kind "-" (get p :slug)))
          :style "border-bottom:1px solid #eee"
        ;; AJAX relate: sx-post the relation, then sx-swap="outerHTML" re-renders the
        ;; WHOLE relation editor for this kind (its sx-target #rel-editor-KIND) — the
        ;; just-related post moves into the current-relations list and out of the
        ;; candidate pool, and the fresh picker re-loads its candidates. (A bare
        ;; delete of this row added the relation server-side but never showed it in
        ;; the current list; re-rendering the editor keeps BOTH lists in sync.)
        ;; method+action stay for the no-JS fallback (plain POST -> 303 -> reload).
        (form :method "post" :style "margin:0"
          :action (unquote (str "/" slug "/relate"))
          :sx-post (unquote (str "/" slug "/relate"))
          :sx-target (unquote (str "#rel-editor-" kind))
          :sx-swap "outerHTML"
          (input :type "hidden" :name "other" :value (unquote (get p :slug)))
          (input :type "hidden" :name "kind" :value (unquote kind))
          (button :type "submit"
            :style "width:100%;text-align:left;background:none;border:none;padding:0.5em;cursor:pointer"
            (unquote (get p :title))))))))

;; The infinite-scroll "load more" sentinel: an <li> that, when scrolled into view
;; (sx-trigger "revealed"), GETs the NEXT page and replaces ITSELF (sx-swap
;; outerHTML, default self-target) with those rows + the next sentinel. This is the
;; SX-htmx engine doing the paging — no client JS. q is %-encoded back into the URL
;; so the filter is preserved across pages.
(define host/blog--picker-more
  (fn (slug kind q next)
    (quasiquote
      (li :class "rp-more"
        :style "list-style:none;padding:0.5em;text-align:center;opacity:0.6"
        :sx-get (unquote (str "/" slug "/relate-options?kind=" kind
                           "&q=" (dr/url-encode q) "&offset=" next))
        :sx-trigger "revealed"
        :sx-swap "outerHTML"
        ;; a dropped/offline page-fetch retries with exponential backoff (1s→30s)
        ;; until it succeeds, so a flaky connection self-heals as you scroll.
        :sx-retry "exponential:1000:30000"
        "Loading more…"))))

;; GET /<slug>/relate-options?kind=&q=&offset= — one page of candidate rows for a
;; kind as an HTML fragment, swapped into the picker by the SX-htmx engine. A full
;; page is followed by a "load more" sentinel (above); the last page is not. Public
;; read; the relate action stays guarded.
(define host/blog-relate-options
  (fn (req)
    (let ((slug (dream-param req "slug"))
          (kind (or (dream-query-param req "kind") "related"))
          ;; dream's query parser does not %-decode values (its form parser does),
          ;; so a filter like "Item 13" arrives as "Item%2013" — decode it.
          (q (dr/url-decode (or (dream-query-param req "q") "")))
          (offset (host/query-int req "offset" 0)))
      (let ((page (host/blog--relate-candidates slug q kind offset host/blog--picker-limit)))
        (let ((rows (join "" (map (fn (p) (render-page (host/blog--picker-item slug p kind))) page)))
              (more (if (= (len page) host/blog--picker-limit)
                      (render-page (host/blog--picker-more slug kind q (+ offset host/blog--picker-limit)))
                      "")))
          (dream-html (str rows more)))))))


;; ── page shell ──────────────────────────────────────────────────────
;; A page is an SX element tree, rendered via render-page (5.1). The handler
;; builds the tree (running any dynamic logic in the full evaluator, e.g. a posts
;; loop) and render-page renders the static result — no embedded HTML strings,
;; only the doctype prefix render-to-html doesn't emit. `body` is an SX node.
;; SPA shell. The blog is a single-page app: the page boots the WASM OCaml kernel
;; (the SAME evaluator as the server) + the SX-htmx engine (web/engine.sx), and
;; `sx-boost="#content"` turns every in-page link/form into a fragment swap into
;; #content — no full reloads, history handled. A boosted request carries the
;; SX-Request:true header; we then return ONLY the inner content (so the engine
;; swaps it straight into #content). A direct / no-JS request gets the full shell,
;; so the blog degrades gracefully to plain server-rendered pages.
(define host/blog--spa-req? (fn (req) (= (dream-header req "sx-request") "true")))

;; An AJAX editor swap (the picker's relate / the editor's remove) vs. a plain
;; boosted form. The engine sends an SX-Target header for an sx-post form
;; (sx-target=#rel-editor-…), but NOT for a plain boosted form (the is-a-tag
;; toggle). So this tells "return the re-rendered editor fragment" apart from
;; "redirect + re-render #content" (the toggle / no-JS path).
(define host/blog--editor-swap-req?
  (fn (req)
    (and (host/blog--spa-req? req)
         (let ((t (dream-header req "sx-target"))) (and t (not (= t "")))))))

(define host/blog--page
  (fn (req title body)
    (if (host/blog--spa-req? req)
      ;; SPA fragment: SX WIRE FORMAT (text/sx), not HTML. The WASM kernel parses
      ;; + renders it client-side into #content (the engine's handle-sx-response).
      ;; No server-side HTML render on the boosted path.
      (serialize body)
      ;; full SPA shell: WASM kernel + platform + boosted #content (server HTML
      ;; for first load / no-JS / SEO)
      (str "<!doctype html>"
        (render-page
          (quasiquote
            (html
              (head (meta :charset "utf-8") (title (unquote title))
                ;; content-addressed module manifest: {file -> hash}. The client's
                ;; loadBytecodeFile reads this and fetches each web-stack module
                ;; immutably from /sx/h/{hash} (localStorage-cached, never stale)
                ;; instead of /static/wasm/sx/*.sxbc with max-age.
                (script :type "application/json" :data-sx-manifest "1"
                  (raw! (unquote (host/static-manifest-json))))
                (script :src "/static/wasm/sx_browser.bc.wasm.js")
                (script :src "/static/wasm/sx-platform.js")
                ;; Visible failure state for the SX engine's .sx-error class (added
                ;; on a failed/offline fetch, cleared on the next success). Without
                ;; it a stuck retry is invisible — the picker just sits "Loading…".
                (style (raw! (unquote (str
                  ".rp-more.sx-error{color:#b00}"
                  ".rp-more.sx-error::after{content:\" — offline, retrying…\"}"
                  ".relate-picker.sx-error .rp-results::before{"
                    "content:\"Connection problem — retrying…\";display:block;"
                    "padding:.5em;color:#b00;font-size:.9em}")))))
              (body
                ;; sx-boost must be on a DESCENDANT of <body> (process-boosted
                ;; queries [sx-boost] WITHIN the body, so it can't sit on body
                ;; itself). The wrapper boosts every link/form inside, targeting
                ;; #content; #content is the swap target.
                (div :sx-boost "#content"
                  ;; persistent top nav OUTSIDE #content, so it survives every
                  ;; content swap; the Home link is boosted (SPA nav to /).
                  (nav :style "padding:0.75em 0;border-bottom:1px solid #ccc;margin-bottom:1em"
                    (a :href "/" :style "font-weight:bold;text-decoration:none" "Home"))
                  (div :id "content" (unquote body)))))))))))

;; Wrap a host/blog--page result in a response with the matching content-type:
;; text/sx for a boosted (SPA) request (the WASM kernel renders it), text/html
;; for a full-page request. Replaces the old dream-html/-status wrappers so the
;; boosted path ships SX instead of server-rendered HTML.
(define host/blog--resp
  (fn (req status str)
    (dream-response status
      {:content-type
        (if (host/blog--spa-req? req) "text/sx; charset=utf-8" "text/html; charset=utf-8")}
      str)))

;; ── registry-driven relation rendering (post page) ──────────────────
;; One labelled block of links from records ({:slug :title}), or "" when empty.
;; Records are pre-fetched, so the tree is built from in-memory data only.
(define host/blog--edges-block
  (fn (records label)
    (if (> (len records) 0)
      (let ((items (map (fn (p)
                          (quasiquote
                            (li (a :href (unquote (str "/" (get p :slug) "/"))
                                  (unquote (get p :title))))))
                     records)))
        (quasiquote
          (div :style "margin-top:2em"
            (h3 (unquote label))
            (unquote (cons (quote ul) items)))))
      "")))

;; nodes -> {:slug :title} records, existence-filtered against a shared key set.
(define host/blog--recs
  (fn (existing nodes)
    (map (fn (s) {:slug s :title (get (host/blog-get s) :title)})
      (filter (fn (s) (contains? existing s))
        (map (fn (n) (substr (symbol->string n) 5))
          (filter (fn (n) (starts-with? (symbol->string n) "blog:")) nodes))))))

;; The relation blocks shown on a POST page — a CURATED, fixed set: Related (out),
;; Tags (out), Tagged-with-this (in). PERFORMANCE: read the KV key list ONCE and
;; derive both the post set and the edges from it in memory, instead of letting
;; each host/blog-out/in re-scan the store. Every durable read is a perform routed
;; through cek_run_with_io (costly deep in the call stack), so the post page must
;; minimise them — this does ONE kv-keys plus a host/blog-get per linked post.
(define host/blog--post-relation-specs
  (list {:kind "related" :dir "out" :label "Related posts"}
        {:kind "tagged"  :dir "out" :label "Tags"}
        {:kind "tagged"  :dir "in"  :label "Tagged with this"}))
;; in-memory: the slug list (out: dst, in: src) for `slug` under `kind` from
;; pre-parsed edges — no perform.
(define host/blog--edges-for
  (fn (edges slug kind dir)
    (reduce
      (fn (acc e)
        (if (= (get e :kind) kind)
          (if (= dir "out")
            (if (= (get e :src) slug) (concat acc (list (get e :dst))) acc)
            (if (= (get e :dst) slug) (concat acc (list (get e :src))) acc))
          acc))
      (list) edges)))
;; slug list -> {:slug :title} records (existence-filtered), one host/blog-get each.
(define host/blog--recs-slugs
  (fn (existing slugs)
    (map (fn (s) {:slug s :title (get (host/blog-get s) :title)})
      (filter (fn (s) (contains? existing s)) slugs))))
(define host/blog--relation-blocks
  (fn (slug)
    (let ((keys (persist/backend-kv-keys host/blog-store)))   ;; ONE durable read
      (let ((existing (reduce (fn (acc k)
                                (if (starts-with? k "blog:")
                                  (concat acc (list (substr k 5))) acc))
                        (list) keys))
            (edges (filter (fn (e) (not (nil? e)))
                     (map host/blog--parse-edge-key keys))))
        (let ((blocks
                (reduce
                  (fn (acc spec)
                    (let ((b (host/blog--edges-block
                               (host/blog--recs-slugs existing
                                 (host/blog--edges-for edges slug (get spec :kind) (get spec :dir)))
                               (get spec :label))))
                      (if (= b "") acc (concat acc (list b)))))
                  (list)
                  host/blog--post-relation-specs)))
          (if (> (len blocks) 0) (cons (quote div) blocks) ""))))))

;; the relation section for the post page: the blocks, or — when empty and the
;; viewer is logged in — a subtle "add some" hint; nothing for anonymous viewers.
(define host/blog--relations-or-hint
  (fn (slug logged-in)
    (let ((blocks (host/blog--relation-blocks slug)))
      (cond
        ((not (= blocks "")) blocks)
        (logged-in
          (quasiquote
            (p :style "margin-top:2em;font-size:0.9em;opacity:0.7"
              "No relations yet — "
              (a :href (unquote (str "/" slug "/edit")) "add some") ".")))
        (else "")))))

;; Kind-aware relation editor for the edit page: current links (each with a
;; kind-scoped remove), plus a filterable picker (a declarative SX-htmx form, one
;; per kind). The picker's candidates come from the kind's registry :candidates
;; ("all" / tags / types).
(define host/blog--relation-editor
  (fn (slug kind with-cands)
    ;; current edges read up front (a perform) — NOT inside the quasiquote, where
    ;; a perform would raise VmSuspended under http-listen.
    (let ((spec (host/blog--kind-spec kind))
          (current (host/blog-out slug kind))
          ;; results <ul>. When `with-cands` (the relate/unrelate fragment), the first
          ;; page of candidates is server-rendered in, so the re-rendered picker is
          ;; never briefly empty (the load trigger then re-fetches the same page and
          ;; morphs it in, invisibly). On the INITIAL edit page it renders EMPTY and the
          ;; load trigger fills it — server-rendering candidates for EVERY kind's picker
          ;; would do a durable read per candidate × every editor, blowing the
          ;; http-listen render budget (VmSuspended). Built by cons so candidate
          ;; li-trees splice in as children (component args would evaluate them).
          (results-ul
            (let ((rows (if with-cands
                          (let ((cands (host/blog--relate-candidates slug "" kind 0 host/blog--picker-limit)))
                            (append
                              (map (fn (p) (host/blog--picker-item slug p kind)) cands)
                              (if (= (len cands) host/blog--picker-limit)
                                (list (host/blog--picker-more slug kind "" host/blog--picker-limit))
                                (list))))
                          (list))))
              (cons (quote ul)
                (append
                  (quasiquote (:id (unquote (str "rp-" kind "-results"))
                               :class "rp-results"
                               :style "list-style:none;padding:0;margin:0.5em 0;border:1px solid #ddd"))
                  rows)))))
      (quasiquote
        ;; #rel-editor-KIND wraps the WHOLE editor (current list + picker) so relate
        ;; and unrelate can re-render it with one outerHTML swap — keeping the two
        ;; lists in sync. The fresh picker re-loads its candidates (an explicit
        ;; outerHTML swap installs a NEW form the engine binds, unlike the old
        ;; redirect that morphed the stale picker and left it empty).
        (div :id (unquote (str "rel-editor-" kind))
             :style "margin-top:2em;border-top:1px solid #ccc;padding-top:1em"
          (h3 (unquote (get spec :label)))
          (unquote
            (if (> (len current) 0)
              (cons (quote ul)
                (map (fn (s)
                       (quasiquote
                         ;; remove: sx-post the unrelate, then sx-swap="outerHTML"
                         ;; re-renders this kind's editor (its sx-target
                         ;; #rel-editor-KIND) — the row leaves the current list and
                         ;; the post returns to the candidate pool, both in sync,
                         ;; with the picker NOT cleared. method+action stay for no-JS.
                         (li (a :href (unquote (str "/" s "/")) (unquote s)) " "
                           (form :method "post" :style "display:inline"
                             :action (unquote (str "/" slug "/unrelate"))
                             :sx-post (unquote (str "/" slug "/unrelate"))
                             :sx-target (unquote (str "#rel-editor-" kind))
                             :sx-swap "outerHTML"
                             (input :type "hidden" :name "other" :value (unquote s))
                             (input :type "hidden" :name "kind" :value (unquote kind))
                             (button :type "submit" "remove")))))
                  current))
              (quote (p :style "opacity:0.7" "None yet."))))
          ;; The picker, rendered INLINE (not via the ~relate-picker component) so the
          ;; first page of candidates is server-rendered into the results <ul> — the
          ;; re-rendered editor shows them immediately, no empty flash. Same declarative
          ;; SX-htmx form: GET relate-options, innerHTML-swap the results on a debounced
          ;; "input" and on "load"; sx-retry self-heals a dropped fetch.
          (form
            :class "relate-picker"
            :data-slug (unquote slug)
            :data-kind (unquote kind)
            :sx-get (unquote (str "/" slug "/relate-options"))
            :sx-trigger "input delay:200ms, load"
            :sx-target (unquote (str "#rp-" kind "-results"))
            :sx-swap "innerHTML"
            :sx-retry "exponential:1000:30000"
            :style "margin:0"
            (input :type "hidden" :name "kind" :value (unquote kind))
            (input :type "text" :name "q" :class "rp-filter" :placeholder "filter…"
              :autocomplete "off" :style "width:100%;padding:0.4em;box-sizing:border-box")
            (unquote results-ul)))))))

;; "Is this post a tag?" toggle — marking a post a tag is just an is-a edge to the
;; "tag" type-post, so it reuses the relate/unrelate routes (no new endpoint).
(define host/blog--is-tag-toggle
  (fn (slug)
    (if (host/blog-is-tag? slug)
      (quasiquote
        (p (span "This post is a tag ✓  ")
          (form :method "post" :style "display:inline"
            :action (unquote (str "/" slug "/unrelate"))
            (input :type "hidden" :name "other" :value "tag")
            (input :type "hidden" :name "kind" :value "is-a")
            (button :type "submit" "remove tag status"))))
      (quasiquote
        (form :method "post" :action (unquote (str "/" slug "/relate"))
          (input :type "hidden" :name "other" :value "tag")
          (input :type "hidden" :name "kind" :value "is-a")
          (button :type "submit" "Make this a tag"))))))

;; One editor per registry kind, wrapped in a div — the edit page's relation
;; section, generated by ITERATING the registry (add a kind -> it gets an editor).
(define host/blog--relation-editors
  (fn (slug)
    (cons (quote div)
      ;; false: the initial edit page renders empty pickers (the load trigger fills
      ;; each), keeping this render cheap. The relate/unrelate FRAGMENT passes true.
      (map (fn (spec) (host/blog--relation-editor slug (get spec :kind) false))
        host/blog-rel-kinds))))

;; ── read handlers ───────────────────────────────────────────────────
;; Post body is rendered per-block (a guarded HTML string) then injected raw.
(define host/blog-post
  (fn (req)
    (let ((slug (dream-param req "slug")))
      (let ((r (host/blog-get slug)))
        (if r
          ;; Compute everything that does durable reads — body, related block, AND
          ;; the auth footer (a durable session read now) — in let bindings BEFORE
          ;; the quasiquote. IO must run in the handler body, never while the page
          ;; tree is built (a perform there raises VmSuspended under http-listen).
          (let ((principal (host/current-principal req)))
            (let ((body-html (host/blog-render r))
                  ;; 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"
                        (a :href (unquote (str "/" slug "/source")) "view source")
                        " · "
                        (a :href (unquote (str "/" slug "/edit")) "edit")
                        " · "
                        (a :href "/" "all posts")
                        " · "
                        (unquote auth-foot))))))))
          (host/blog--resp req 404
            (host/blog--page req "Not found"
              (quasiquote
                (div (h1 "404")
                  (p (unquote (str "No published post: " slug))))))))))))

(define host/blog-home
  (fn (req)
    (let ((posts (host/blog-list)))
      (let ((items
              (map
                (fn (p)
                  (quasiquote
                    (li (a :href (unquote (str "/" (get p :slug) "/"))
                          (unquote (get p :title))))))
                posts)))
        (let ((listing (if (> (len posts) 0)
                         (cons (quote ul) items)
                         (quote (p "No posts yet."))))
              ;; auth-footer does a durable session read — bind it BEFORE the
              ;; quasiquote (a perform during tree-build raises VmSuspended).
              (auth-foot (host/auth-footer req)))
          (host/blog--resp req 200
            (host/blog--page req "Blog"
              (quasiquote
                (div (h1 "Posts")
                  (unquote listing)
                  (p (a :href "/new" "+ New post"))
                  (p :style "margin-top:2em;font-size:0.9em;opacity:0.8"
                    (a :href "/meta" "metamodel") " · " (a :href "/tags" "tags")
                    " · " (unquote auth-foot)))))))))))

(define host/blog-index (fn (req) (host/ok (host/blog-list))))

;; GET /tags — index of every tag (a post that is-a tag). Tags are posts, so each
;; links to its own page (which documents the tag + lists what's tagged with it).
(define host/blog-tags-index
  (fn (req)
    ;; pre-fetch records (slug+title) BEFORE the quasiquote — host/blog-get is a
    ;; durable read; a perform during tree-build raises VmSuspended.
    (let ((recs (map (fn (s) {:slug s :title (get (host/blog-get s) :title)})
                  (sort (host/blog-instances-of "tag"))))
          (auth-foot (host/auth-footer req)))
      (let ((items (map (fn (p)
                          (quasiquote
                            (li (a :href (unquote (str "/" (get p :slug) "/"))
                                  (unquote (get p :title))))))
                     recs)))
        (host/blog--resp req 200
          (host/blog--page req "Tags"
            (quasiquote
              (div (h1 "Tags")
                (unquote (if (> (len recs) 0)
                           (cons (quote ul) items)
                           (quote (p "No tags yet."))))
                (p :style "margin-top:2em;font-size:0.9em;opacity:0.8"
                  (a :href "/" "all posts") " · " (unquote auth-foot))))))))))

;; ── metamodel overview (GET /meta) ─────────────────────────────────
;; The "see the system you've defined" page: every type-post (with its schema's
;; required blocks) and every relation-post (with its signature). Types + relations
;; are themselves posts, so each row links to the post that defines it. Pure read;
;; durable reads pre-fetched into let bindings BEFORE the quasiquote (a perform during
;; tree-build raises VmSuspended), and relations come from the boot-populated
;; host/blog-rel-kinds VALUE (no perform). The surface the metamodel editor hangs off.
(define host/blog--schema-summary
  (fn (schema)
    (if (and schema (> (len schema) 0))
      (join ", " (map (fn (rule) (get rule :block)) schema))
      "—")))
(define host/blog-meta-index
  (fn (req)
    (let ((type-recs
            (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)))
      (let ((type-rows
              (map (fn (p)
                     (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
              (map (fn (spec)
                     (quasiquote
                       (tr (td (unquote (get spec :kind)))
                           (td (unquote (or (get spec :label) "")))
                           (td (unquote (if (get spec :symmetric) "symmetric" "directed")))
                           (td (unquote (or (get spec :inverse-label) "—"))))))
                rel-specs)))
        (host/blog--resp req 200
          (host/blog--page req "Metamodel"
            (quasiquote
              (div
                (h1 "Metamodel")
                (p "The types and relations that define this system. Each is itself a post — click through to its definition.")
                (h2 (unquote (str "Types (" (len type-recs) ")")))
                (unquote (if (> (len type-recs) 0)
                           (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)
                             (cons (quote (tr (th "Relation") (th "Label") (th "Kind") (th "Inverse"))) rel-rows))
                           (quote (p "No relations yet."))))
                (form :method "post" :action "/meta/new-relation" :style "margin:0.5em 0 1.5em"
                  (input :name "title" :placeholder "New relation name" :style "padding:0.3em")
                  " " (input :name "label" :placeholder "label (optional)" :style "padding:0.3em")
                  " " (label (input :type "checkbox" :name "symmetric") " symmetric")
                  " " (button :type "submit" "+ Relation"))
                (p :style "margin-top:2em;font-size:0.9em;opacity:0.8"
                  (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"))))

;; POST /meta/new-relation — DEFINE A RELATION THROUGH THE UI (metamodel editor):
;; create a relation-post (is-a relation, carrying its :rel metadata) and register it.
;; SESSION-SCOPED (2026-06-30): the relation-post + any edges it gets persist durably,
;; but the rel-kinds REGISTRY entry is added by a runtime concat (safe — the serving
;; handler has the IO resolver) and is LOST on restart, because the boot loader
;; (host/blog-load-rel-kinds!) is unrolled and can't dynamically enumerate under
;; JIT-at-boot (the kernel boot-resolver gap — flagged to the sx-vm-extensions loop in
;; plans/NOTE-render-diff-for-vm-ext.md). Re-creating the relation re-registers it.
(define host/blog-meta-new-relation
  (fn (req)
    (let ((title (host/field req "title"))
          (label (host/field req "label"))
          (symmetric (= (host/field req "symmetric") "on")))
      (when (and title (not (= title "")))
        (let ((slug (host/blog-slugify title)))
          (begin
            (host/blog--seed-rel! slug title symmetric
              (if (or (nil? label) (= label "")) title label) nil)
            (host/blog--cache-rel! slug)
            (set! host/blog-rel-kinds
              (concat host/blog-rel-kinds (list (get host/blog--rel-cache slug)))))))
      (dream-redirect "/meta"))))

;; GET /<slug>/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.
(define host/blog-source
  (fn (req)
    (let ((slug (dream-param req "slug")))
      (let ((r (host/blog-get slug)))
        (if r
          (dream-response 200 {:content-type "text/plain; charset=utf-8"}
            (or (get r :sx-content) ""))
          (host/blog--resp req 404
            (host/blog--page req "Not found"
              (quasiquote (div (h1 "404") (p (unquote (str "No post: " slug))))))))))))

;; ── create page (GET /new) — clean minimal form as an SX tree ───────
;; No legacy JS editor, no external assets, no shims. The rich WYSIWYG is a
;; future native SX-island editor (Phase 5.2+). Posts to /new.
(define host/blog-new-form
  (fn (req)
    (host/blog--resp req 200
      (host/blog--page req "New post"
        (quasiquote
          (div
            (h1 "New post")
            (form :method "post" :action "/new"
              (p (input :name "title" :placeholder "Title"
                   :style "font-size:1.4em;width:100%"))
              (p (textarea :name "sx_content" :rows "12"
                   :style "width:100%;font-family:monospace"
                   :placeholder "(p \"Your post as SX markup\")"))
              (p (select :name "status"
                   (option :value "draft" "Draft")
                   (option :value "published" "Published"))
                " "
                (button :type "submit" "Publish")))
            (p (a :href "/" "all posts"))))))))

;; ── write-time validation ───────────────────────────────────────────
;; sx_content must be storable as renderable SX: empty is allowed (an empty post),
;; otherwise it must parse. parse-safe returns nil on malformed input (the kernel
;; parser raises a native Parse_error an SX guard can't catch), so this rejects a
;; bad body at write time instead of letting it 500 on read. Mirrors the read-path
;; guard in host/blog-render — bad content never enters the durable store.
(define host/blog-content-ok?
  (fn (sx)
    (or (nil? sx) (= sx "") (not (nil? (parse-safe sx))))))

;; ── write handlers ──────────────────────────────────────────────────
;; POST /new — form-urlencoded ingest (the editor's submit shape: title,
;; sx_content, status, custom_excerpt, csrf_token). Slug derived from the title.
;; Redirects to the new post on success; rejects a missing title or unparseable
;; body with a 400 HTML page (this path serves a browser form).
(define host/blog-form-submit
  (fn (req)
    (let ((title (host/field req "title"))
          (sx-content (host/field req "sx_content"))
          (status (or (host/field req "status") "published")))
      (cond
        ((or (nil? title) (= title ""))
          (host/blog--resp req 400
            (host/blog--page req "Error"
              (quasiquote (div (h1 "Error") (p "Title is required.")
                            (p (a :href "/new" "Back")))))))
        ((not (host/blog-content-ok? sx-content))
          (host/blog--resp req 400
            (host/blog--page req "Error"
              (quasiquote (div (h1 "Error") (p "Post body is not valid SX markup.")
                            (p (a :href "/new" "Back")))))))
        (else
          (let ((slug (host/blog-slugify title)))
            (begin
              (host/blog-put! slug title (or sx-content "") status)
              (dream-redirect (str "/" slug "/")))))))))

;; The JSON CRUD /posts (create/update/delete) was DELETED in the greenfield
;; SX-native pivot (plans/relations-as-posts.md, "SX all the way out") — it was a
;; pure old-contract REST mirror. Create + edit go through the HTML editor forms
;; (POST /new, POST /:slug/edit); programmatic writes will speak SXTP. FOLLOW-UP:
;; there is no browser delete route yet (delete was JSON-only and had no UI) — add
;; POST /:slug/delete + cascade edge cleanup (drop every edge touching the slug,
;; both directions, all kinds) when the metamodel UI needs it.

;; POST /<slug>/relate — relate this post to another (form `other` = slug, `kind` =
;; relation kind, default "related"). Validated: kind must be a known kind and the
;; other post must exist and differ; otherwise a no-op. Redirects back to the edit
;; page. Guarded like the other browser write routes.
(define host/blog-relate-submit
  (fn (req)
    (let ((slug (dream-param req "slug"))
          (other (host/field req "other"))
          (kind (or (host/field req "kind") "related")))
      (if (nil? (host/blog-get slug))
        (host/blog--resp req 404
          (host/blog--page req "Not found"
            (quasiquote (div (h1 "404") (p (unquote (str "No post: " slug)))))))
        (begin
          ;; …and `other` must satisfy the relation's TARGET-TYPE CONSTRAINT
          ;; (host/blog--valid-object?): you can only declare `slug is-a <a type>`,
          ;; tag with `<a tag>`, etc. The picker never offers an invalid target, so
          ;; this enforces the same schema against crafted/API requests; an invalid
          ;; relate is a silent no-op (consistent with the other guards here).
          (when (and other (not (= other "")) (not (= other slug))
                     (host/blog--kind-spec kind) (host/blog-exists? other)
                     (host/blog--valid-object? kind other))
            (host/blog-relate! slug other kind))
          ;; AJAX (the picker's sx-post, carries SX-Target): return the re-rendered
          ;; editor for this kind so its sx-swap="outerHTML" replaces #rel-editor-KIND
          ;; — the just-related post shows in the current list and the picker refreshes
          ;; its candidates. text/html so the client's DOMParser swap path renders the
          ;; already-expanded fragment. Plain boosted form / no-JS still redirects.
          (if (host/blog--editor-swap-req? req)
            (dream-html (render-page (host/blog--relation-editor slug kind true)))
            (dream-redirect (str "/" slug "/edit"))))))))

;; POST /<slug>/unrelate — remove the relation to `other` under `kind` (default
;; "related"). Idempotent.
(define host/blog-unrelate-submit
  (fn (req)
    (let ((slug (dream-param req "slug"))
          (other (host/field req "other"))
          (kind (or (host/field req "kind") "related")))
      (begin
        (when (and other (not (= other "")) (host/blog--kind-spec kind))
          (host/blog-unrelate! slug other kind))
        ;; AJAX remove (the editor's sx-post, carries SX-Target): return the
        ;; re-rendered editor for this kind so its sx-swap="outerHTML" replaces
        ;; #rel-editor-KIND — the row leaves the current list, the post returns to the
        ;; (re-loaded) candidate pool, and the picker is NOT cleared. A plain boosted
        ;; form (the tag toggle) or a no-JS POST still redirects + re-renders #content.
        (if (host/blog--editor-swap-req? req)
          (dream-html (render-page (host/blog--relation-editor slug kind true)))
          (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
;; browser shows the source verbatim), and status (current value pre-selected).
;; Guarded: only an editor reaches the editor. Keeps the slug (edits don't re-slug).
(define host/blog-edit-form
  (fn (req)
    (let ((slug (dream-param req "slug")))
      (let ((r (host/blog-get slug)))
        (if (nil? r)
          (host/blog--resp req 404
            (host/blog--page req "Not found"
              (quasiquote (div (h1 "404") (p (unquote (str "No post: " slug)))))))
          (let ((status (get r :status)))
            ;; the relation editors + tag toggle do durable reads — compute them
            ;; 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)
                        (quasiquote (option :value (unquote val) :selected "selected" (unquote label)))
                        (quasiquote (option :value (unquote val) (unquote label)))))))
              (host/blog--resp req 200
                (host/blog--page req (str "Edit: " (get r :title))
                  (quasiquote
                    (div
                      (h1 (unquote (str "Edit: " (get r :title))))
                      (form :method "post" :action (unquote (str "/" slug "/edit"))
                        (p (input :name "title" :value (unquote (get r :title))
                             :style "font-size:1.4em;width:100%"))
                        (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")))
                          " "
                          (button :type "submit" "Save")))
                      (div :style "margin-top:2em;border-top:1px solid #ccc;padding-top:1em"
                        (unquote tag-toggle))
                      (unquote relation-editors)
                      (p :style "margin-top:1.5em"
                        (a :href (unquote (str "/" slug "/")) "view post")
                        " · "
                        (a :href (unquote (str "/" slug "/source")) "view source")))))))))))))

;; POST /<slug>/edit — save the edited source. Same write-time validation as the
;; create paths (unparseable body -> 400, post left intact). Slug is preserved.
(define host/blog-edit-submit
  (fn (req)
    (let ((slug (dream-param req "slug")) (r (host/blog-get (dream-param req "slug"))))
      (if (nil? r)
        (host/blog--resp req 404
          (host/blog--page req "Not found"
            (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)))
              (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)
                          (host/blog-type-issues slug sx-content)
                          (list "Post body is not valid SX markup."))))
            (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
                  (host/blog--page req "Cannot save"
                    (quasiquote
                      (div (h1 "Cannot save")
                        (p "This post can't be saved yet:")
                        (unquote (cons (quote ul) issue-items))
                        (p (a :href (unquote (str "/" slug "/edit")) "Back"))))))))))))))

;; ── routes ──────────────────────────────────────────────────────────
;; Public reads + the create form. /, /posts, /new BEFORE /:slug (catch-all).
;; MUST be mounted LAST in the app so domain routes (/feed, /health) win.
(define host/blog-routes
  (list
    (dream-get "/" host/blog-home)
    (dream-get "/posts" host/blog-index)
    (dream-get "/new" host/blog-new-form)
    (dream-get "/tags" host/blog-tags-index)
    (dream-get "/meta" host/blog-meta-index)
    (dream-get "/:slug/source" host/blog-source)
    (dream-get "/:slug/relate-options" host/blog-relate-options)
    (dream-get "/:slug" host/blog-post)))

;; Guarded writes: HTML editor form ingest behind auth+ACL. (The JSON CRUD that
;; used a bearer-based host/blog--protect was deleted in the SX-native pivot.)
;; Browser gate: identical ACL, but an unauthenticated request REDIRECTS
;; to the login page (host/require-login) rather than returning a raw JSON 401 —
;; the form/edit pages are HTML, so a logged-out click should land on /login and
;; return here afterwards.
(define host/blog--protect-html
  (fn (resolve h)
    (host/pipeline
      (list
        host/wrap-errors
        (host/require-login resolve)
        (host/require-permission "edit" (fn (req) "blog")))
      h)))
(define host/blog-write-routes
  (fn (resolve)
    (list
      (dream-post "/new" (host/blog--protect-html resolve host/blog-form-submit))
      (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 "/meta/new-type" (host/blog--protect-html resolve host/blog-meta-new-type))
      (dream-post "/meta/new-relation" (host/blog--protect-html resolve host/blog-meta-new-relation)))))

;; EXPERIMENTAL: create-only, UNGUARDED — POST /new form ingest with error
;; trapping but NO auth, for validating the editor->host publish loop on the
;; experimental subdomain. Create-only by design (no PUT/DELETE), so the worst
;; case is junk posts, not overwrite/delete. GATE before any real use.
(define host/blog-open-create-routes
  (list
    (dream-post "/new" (host/pipeline (list host/wrap-errors) host/blog-form-submit))))