;; 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, KV-only) ─────────────────
;; The blog graph is the durable KV: every edge is a row "edge:<src>|<kind>|<dst>" in the
;; blog store, and ALL reads walk those rows directly (host/blog--all-edges / -out / -in /
;; --subtype-closure). It is NOT mirrored into lib/relations: relations/relate re-saturates
;; the whole Datalog ruleset on EVERY write (super-linear in the fact base — profiled at
;; 1→3→6s per edge as the graph grows), and since typing now reads direct KV edges, nothing
;; in the blog domain reads lib/relations, so the mirror was pure (very expensive) dead
;; weight. KV-only edge writes are ~20ms flat. '|' is a safe delimiter — slugs are
;; [a-z0-9-], kinds are registry names. (host/relations.sx, the relations DOMAIN service, is
;; separate: its own "type:id" nodes in lib/relations, untouched by this.)
(define host/blog--edge-key (fn (src kind dst) (str "edge:" src "|" kind "|" dst)))

(define host/blog--add-edge!
  (fn (src dst 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)
    (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)))))

;; No-op: the durable KV edge rows ARE the graph and every read walks them directly, so
;; there is no in-memory lib/relations graph to rebuild on boot. (Kept as a callable seam —
;; serve.sh calls it after pointing the store at the durable backend — in case a future
;; index/cache needs warming.) Previously this replayed every edge into lib/relations via
;; relations/relate, which re-saturated the Datalog ruleset per edge: O(edges²) boot cost.
(define host/blog-load-edges! (fn () nil))

;; 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.
;;
;; PERF: the subtype closure is computed HOST-SIDE by a BFS over the DIRECT subtype-of
;; edges (the edge:* KV rows), NOT via lib/relations descendants/ancestors. Each lib/
;; relations query re-saturates the whole (CEK-interpreted) Datalog ruleset — ~seconds
;; even on a tiny graph — and typing is on the hottest path (is-a?/types-of/instances-of
;; run per post, per picker, per render), so re-saturation made the blog suite + live
;; pages CPU-bound. The closure is the SAME transitive set; one edge-store snapshot drives
;; the whole BFS (O(edges), cycle-safe). KV == relations for direct edges (host/blog-relate!
;; writes both), so this is exact, not an approximation.
(define host/blog--uniq
  (fn (xs) (reduce (fn (acc x) (if (contains? acc x) acc (concat acc (list x)))) (list) xs)))

;; transitive closure over DIRECT subtype-of edges from `roots` (roots included), with NO
;; Datalog. dir :out = follow src->dst (the supertypes of roots); dir :in = follow dst->src
;; (the subtypes of roots). One host/blog--all-edges snapshot; BFS with a `seen` guard.
(define host/blog--subtype-closure
  (fn (roots dir)
    (let ((edges (host/blog--all-edges)) (existing (host/blog-slugs)))
      (let ((step
              (fn (n)
                (filter (fn (s) (contains? existing s))
                  (reduce (fn (acc e)
                            (if (and (= (get e :kind) "subtype-of")
                                     (= (get e (if (= dir :out) :src :dst)) n))
                              (concat acc (list (get e (if (= dir :out) :dst :src)))) acc))
                          (list) edges)))))
        (let loop ((frontier roots) (seen (list)))
          (if (empty? frontier)
            seen
            (let ((n (first frontier)))
              (if (contains? seen n)
                (loop (rest frontier) seen)
                (loop (concat (rest frontier) (step n)) (concat seen (list n)))))))))))

(define host/blog-types-of
  (fn (slug)
    (host/blog--uniq (host/blog--subtype-closure (host/blog-out slug "is-a") :out))))

;; 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. O(edges) over one snapshot — the
;; efficient way to enumerate a type's members (e.g. "all tags") for the picker.
(define host/blog-instances-of
  (fn (type)
    (host/blog--uniq
      (reduce (fn (acc t) (concat acc (host/blog-in t "is-a")))
              (list) (host/blog--subtype-closure (list type) :in)))))

;; 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). Used by the metamodel editor.
(define host/blog-type-defs
  (fn () (host/blog--uniq (host/blog--subtype-closure (list "type") :in))))

;; ── 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}))))))

;; ── composition objects (plans/composition-objects.md) ──────────────
;; A record may carry a :body — a composition node (seq/par/alt/each over object refs)
;; rendered by the render-fold (lib/host/compose.sx) against a context. When present it
;; supersedes :sx-content. This is fold #1; the same object renders differently per context.
(define host/blog-body-of (fn (slug) (get (host/blog-get slug) :body)))
(define host/blog--set-body!
  (fn (slug body)
    (let ((r (host/blog-get slug)))
      (when r (host/blog--write! slug (merge r {:body body}))))))
;; The resolver for the composition `each` graph-query source (compose.sx asks the context
;; for "query"). `(query REL TYPE)` -> the objects related to TYPE by REL, as full records
;; so the per-item template can field them. Today the supported relation is is-a (TYPE's
;; transitive instances, via host/blog-instances-of); the dispatch leaves room for more.
;; This is the DATA-DRIVEN each source — the object's `each` is the query, the render is
;; the run over whatever the graph currently holds.
(define host/blog--comp-query
  (fn (qargs ctx)
    (let ((rel (str (first qargs))) (type (str (first (rest qargs)))))
      (cond
        ((= rel "is-a") (map host/blog-get (host/blog-instances-of type)))
        (else (list))))))
;; live context values, read PURELY from the request headers (no perform) so the SAME
;; object renders responsively/personalised per request — `(alt (when (eq "device" "mobile")
;; …) …)` is a responsive layout, `(when (eq "locale" "fr") …)` a localised variant.
(define host/blog--device-of
  (fn (req)
    (let ((ua (str (or (dream-header req "user-agent") ""))))
      (if (or (contains? ua "Mobile") (contains? ua "Android") (contains? ua "iPhone"))
        "mobile" "desktop"))))
(define host/blog--locale-of
  (fn (req)
    (let ((al (str (or (dream-header req "accept-language") ""))))
      (if (>= (len al) 2) (substr al 0 2) "en"))))
;; the `ref` transclude resolver (compose.sx asks the context for "ref"): render the
;; referenced object. A decomposed card object is-a a card-type with field-values + the
;; card-type carries a :template, so it renders via the SAME typed-block path articles
;; use; render-page turns that SX tree into HTML. Empty for an absent / template-less ref.
(define host/blog--comp-ref
  (fn (slug ctx)
    (let ((tb (host/blog--typed-block slug)))
      (if (= tb "") "" (render-page tb)))))
;; the render context for a :body: auth from the principal + live device/locale from the
;; request + the graph-query resolver + the transclude resolver. The context is the
;; EXECUTION environment — the object (its when-variants) is the definition; this picks
;; which path renders.
(define host/blog--comp-ctx
  (fn (principal req)
    (merge
      (merge (if (nil? principal) {} {"auth" "yes"})
             (if (nil? req) {} {"device" (host/blog--device-of req) "locale" (host/blog--locale-of req)}))
      {"query" host/blog--comp-query "ref" host/blog--comp-ref})))

;; ── cards-as-objects: decompose content into card OBJECTS + a `contains` body ────────
;; A post body is not one opaque sx_content string but a `contains` DAG of separate,
;; content-addressed card OBJECTS. host/blog--decompose! splits an (article …) tree into
;; one card object per top-level block (is-a the mapped card-type + its field-values),
;; links each by an ordered `contains` edge, and sets the post's :body to (seq (ref c0)
;; (ref c1) …). The render-fold then transcludes each card via its type template. This is
;; the cards-as-objects decision made real for the importer (plans/composition-objects.md).

;; the text content of a block element: its string children joined, skipping :attr pairs,
;; recursing into nested elements. Carries prose into a card field (good enough for import).
(define host/blog--args-text
  (fn (args)
    (cond
      ((empty? args) "")
      ((= (type-of (first args)) "keyword") (host/blog--args-text (rest (rest args))))
      (else (str (host/blog--elem-text (first args)) (host/blog--args-text (rest args)))))))
(define host/blog--elem-text
  (fn (node)
    (cond
      ((= (type-of node) "string") node)
      ((and (= (type-of node) "list") (> (len node) 0)) (host/blog--args-text (rest node)))
      (else ""))))
;; the value of an :attr on an element (e.g. img :src), "" if absent.
(define host/blog--elem-attr
  (fn (node key)
    (let loop ((args (if (= (type-of node) "list") (rest node) (list))))
      (cond
        ((empty? args) "")
        ((and (= (type-of (first args)) "keyword") (= (str (first args)) key))
         (if (empty? (rest args)) "" (str (first (rest args)))))
        ((= (type-of (first args)) "keyword") (loop (rest (rest args))))
        (else (loop (rest args)))))))
;; map an element tag to a card-type (the block vocabulary). Unknown tags -> text card.
(define host/blog--tag->card-type
  (fn (tag)
    (cond
      ((or (= tag "h1") (= tag "h2") (= tag "h3") (= tag "h4")) "card-heading")
      ((= tag "img") "card-image")
      ((= tag "blockquote") "card-quote")
      ((or (= tag "pre") (= tag "code")) "card-code")
      (else "card-text"))))
;; the field-values for a card-type extracted from the original block element.
(define host/blog--block-fields
  (fn (orig-tag ctype block)
    (cond
      ((= ctype "card-heading") {"level" (if (>= (len orig-tag) 2) (substr orig-tag 1) "2")
                                 "text" (host/blog--elem-text block)})
      ((= ctype "card-image")   {"src" (host/blog--elem-attr block "src")
                                 "alt" (host/blog--elem-attr block "alt") "caption" ""})
      ((= ctype "card-code")    {"code" (host/blog--elem-text block) "language" ""})
      ((= ctype "card-quote")   {"text" (host/blog--elem-text block) "cite" ""})
      (else                     {"text" (host/blog--elem-text block)}))))
;; decompose a post's content-tree into card objects + a contains body. Idempotent
;; (seed!/relate!/set-body! are sets; re-import overwrites the same __bN card objects).
(define host/blog--decompose!
  (fn (post-slug content-tree)
    (let ((blocks (if (and (= (type-of content-tree) "list") (> (len content-tree) 0))
                    (filter (fn (b) (= (type-of b) "list")) (rest content-tree))
                    (list))))
      (when (not (empty? blocks))
        (let ((refs
               (map-indexed
                 (fn (i block)
                   (let ((orig-tag (str (first block))) (cslug (str post-slug "__b" i)))
                     (let ((ctype (host/blog--tag->card-type orig-tag)))
                       (begin
                         ;; status "block" hides the card object from listings; it still
                         ;; renders when transcluded (typed-block ignores status).
                         (host/blog-seed! cslug ctype "(article (h1 \"card\"))" "block")
                         (host/blog-relate! cslug ctype "is-a")
                         (host/blog--set-field-values! cslug (host/blog--block-fields orig-tag ctype block))
                         (host/blog-relate! post-slug cslug "contains")
                         (list (quote ref) cslug)))))
                 blocks)))
          (host/blog--set-body! post-slug (cons (quote seq) refs)))))))

;; ── block-editor model: edit a post's :body (its composition of card refs) ───────────
;; The body is (seq (ref c0) (ref c1) …); these ops add / remove / reorder its blocks and
;; keep the ordered `contains` edges in step. The :body seq is the ORDER authority, the
;; contains edges the membership set. Per-block FIELD editing is free: a card is an object,
;; so its fields are edited via the card's own /<cslug>/edit page. (composition step 6.)
(define host/blog-body-refs
  (fn (slug)
    (let ((body (host/blog-body-of slug)))
      (if (and (= (type-of body) "list") (= (str (first body)) "seq"))
        (reduce (fn (acc n)
                  (if (and (= (type-of n) "list") (= (str (first n)) "ref"))
                    (concat acc (list (str (first (rest n))))) acc))
                (list) (rest body))
        (list)))))
(define host/blog--set-body-refs!
  (fn (slug refs)
    (host/blog--set-body! slug (cons (quote seq) (map (fn (r) (list (quote ref) r)) refs)))))
(define host/blog--next-block-idx
  (fn (slug)
    (let loop ((i 0))
      (if (host/blog-exists? (str slug "__b" i)) (loop (+ i 1)) i))))
(define host/blog-block-add!
  (fn (slug ctype fields)
    (let ((cslug (str slug "__b" (host/blog--next-block-idx slug))))
      (begin
        (host/blog-seed! cslug ctype "(article (h1 \"card\"))" "block")
        (host/blog-relate! cslug ctype "is-a")
        (host/blog--set-field-values! cslug fields)
        (host/blog-relate! slug cslug "contains")
        (host/blog--set-body-refs! slug (concat (host/blog-body-refs slug) (list cslug)))
        cslug))))
(define host/blog-block-remove!
  (fn (slug cslug)
    (begin
      (host/blog--set-body-refs! slug
        (filter (fn (r) (not (= r cslug))) (host/blog-body-refs slug)))
      (host/blog-unrelate! slug cslug "contains"))))
(define host/blog--nth-ref
  (fn (xs k)
    (let loop ((i 0) (ys xs))
      (cond ((empty? ys) nil) ((= i k) (first ys)) (else (loop (+ i 1) (rest ys)))))))
(define host/blog--ref-index
  (fn (xs x)
    (let loop ((i 0) (ys xs))
      (cond ((empty? ys) -1) ((= (first ys) x) i) (else (loop (+ i 1) (rest ys)))))))
(define host/blog-block-move!
  (fn (slug cslug dir)
    (let ((refs (host/blog-body-refs slug)))
      (let ((i (host/blog--ref-index refs cslug)))
        (let ((j (if (= dir "up") (- i 1) (+ i 1))))
          (when (and (>= i 0) (>= j 0) (< j (len refs)))
            (host/blog--set-body-refs! slug
              (map-indexed (fn (k r) (cond ((= k i) (host/blog--nth-ref refs j))
                                           ((= k j) (host/blog--nth-ref refs i))
                                           (else r))) refs))))))))
;; the card-type of a card object (its declared is-a target); "card" if none.
(define host/blog--primary-card-type
  (fn (cslug) (let ((ts (host/blog-out cslug "is-a"))) (if (empty? ts) "card" (first ts)))))
;; a short text preview of a card's content from its field-values.
(define host/blog--block-preview
  (fn (vals)
    (let ((t (str (or (get vals "text") (get vals "src") (get vals "code") (get vals "url") ""))))
      (if (> (len t) 60) (str (substr t 0 60) "…") t))))
;; Seed a live demo of the composition fold: one object, rendered by host/comp-render, that
;; shows seq + alt(when auth) + row(par) + each — and renders DIFFERENTLY logged-in vs out.
(define host/blog-seed-compose-demo!
  (fn ()
    (begin
      ;; a demo type + two instances, so the each(query …) below iterates REAL graph data —
      ;; the list isn't baked into the body, it's whatever is-a compose-item right now.
      (host/blog-seed! "compose-item" "Compose Item" "(article (h1 \"Compose Item\"))" "published")
      (host/blog-relate! "compose-item" "type" "subtype-of")
      (host/blog-seed! "compose-item-revel" "Revel Show" "(article (h1 \"Revel Show\"))" "published")
      (host/blog-seed! "compose-item-pub"   "Pub Night"  "(article (h1 \"Pub Night\"))"  "published")
      (host/blog-relate! "compose-item-revel" "compose-item" "is-a")
      (host/blog-relate! "compose-item-pub"   "compose-item" "is-a")
      (host/blog-seed! "compose-demo" "Composition Demo"
        "(article (h1 \"Composition Demo\") (p \"Rendered via the composition fold.\"))" "published")
      (host/blog--set-body! "compose-demo"
        (quote (seq
          (text "<p>This whole page is <b>one composition object</b>, rendered by the fold — it renders differently depending on context.</p>")
          (alt (when (has "auth") (text "<p style=\"color:green\"><b>Members:</b> you are logged in.</p>"))
               (else (text "<p style=\"color:#999\"><i>Log in to see the member-only block.</i></p>")))
          ;; live context: a responsive variant chosen by the request's device (User-Agent).
          (alt (when (eq "device" "mobile") (text "<p>📱 <b>Mobile layout</b> (device from the request).</p>"))
               (else (text "<p>🖥️ <b>Desktop layout</b> (device from the request).</p>")))
          (text "<h3>Two columns (par)</h3>")
          (row (text "<div style=\"flex:1;border:1px solid #ccc;padding:0.5em\">Column A</div>")
               (text "<div style=\"flex:1;border:1px solid #ccc;padding:0.5em\">Column B</div>"))
          (text "<h3>A list (each over a graph query)</h3><ul>")
          (each (query is-a compose-item)
            (seq (text "<li><a href=\"/") (val :slug) (text "\">") (field :title) (text "</a></li>")))
          (text "</ul>")))))))
;; 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"))))

;; ── cards-as-types (the blog content vocabulary) ────────────────────
;; Seed a card-type: a type-post subtype-of "card" with its own fields. The kg-card /
;; content-on-sx block vocabulary becomes the metamodel's card types, so the editor's
;; card palette + a post's body blocks are driven by type definitions, and the radar
;; migrator (plans/NOTE-blog-types-for-radar.md) maps old Ghost cards onto these.
(define host/blog--seed-card-type!
  (fn (slug title fields template)
    (begin
      (host/blog-seed! slug title
        (str "(article (h1 \"" title "\") (p \"A " title " card — a kind of content block. Its fields define what the editor collects and the template renders.\"))")
        "published")
      (host/blog-relate! slug "card" "subtype-of")
      (host/blog--set-fields! slug fields)
      ;; a card type carries a render :template (SX tree with (field "name") placeholders),
      ;; so a card OBJECT renders via the SAME typed-block path articles use — and a `(ref)`
      ;; in a post body transcludes it. This is what makes cards-as-objects render.
      (when template (host/blog--set-template! slug template)))))

;; 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\"))")
      ;; ── cards-as-types: the blog content block vocabulary (kg-cards / content-on-sx
      ;; block kinds) as metamodel types. "card" is the root; each card kind is a subtype
      ;; with its own fields. These define the editor's card palette + the radar migrator's
      ;; target vocabulary (plans/NOTE-blog-types-for-radar.md). Instances-as-blocks vs
      ;; instances-as-posts is a later decision; this is the vocabulary.
      (host/blog-seed! "card" "Card"
        "(article (h1 \"Card\") (p \"A content block — the building unit of a post body. Each card kind is a type with its own fields; the editor collects them and the template renders them.\"))"
        "published")
      (host/blog-relate! "card" "type" "subtype-of")
      (host/blog--seed-card-type! "card-heading" "Heading"
        (list {:name "level" :type "Int"} {:name "text" :type "String"})
        "(h2 (field \"text\"))")
      (host/blog--seed-card-type! "card-text" "Text"
        (list {:name "text" :type "Text"})
        "(p (field \"text\"))")
      (host/blog--seed-card-type! "card-image" "Image"
        (list {:name "src" :type "URL"} {:name "alt" :type "String"} {:name "caption" :type "String"})
        "(figure (img :src (field \"src\") :alt (field \"alt\")) (figcaption (field \"caption\")))")
      (host/blog--seed-card-type! "card-quote" "Quote"
        (list {:name "text" :type "Text"} {:name "cite" :type "String"})
        "(blockquote (field \"text\"))")
      (host/blog--seed-card-type! "card-code" "Code"
        (list {:name "language" :type "String"} {:name "code" :type "Text"})
        "(pre (code (field \"code\")))")
      (host/blog--seed-card-type! "card-embed" "Embed"
        (list {:name "url" :type "URL"} {:name "caption" :type "String"})
        "(div :class \"embed\" (field \"url\"))")
      (host/blog--seed-card-type! "card-callout" "Callout"
        (list {:name "style" :type "String"} {:name "text" :type "Text"})
        "(div :class \"callout\" (field \"text\"))")
      ;; 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))))

;; ── block editor: edit the post :body composition (insert/reorder/remove blocks) ─────
;; A row per block (type + preview + up/down/remove + a link to edit the card's fields) and
;; an add-block form. Each control sx-posts its route, sx-swap="outerHTML" replacing
;; #block-editor with the re-render (live reorder/add/remove). Wrapped for the swap target.
;; one sx-post button-form targeting #block-editor (dir passed as a hidden field).
(define host/blog--block-btn
  (fn (slug cslug action dir label)
    (let ((url (str "/" slug "/blocks/" cslug "/" action)))
      (quasiquote
        (form :method "post" :action (unquote url) :style "display:inline;margin:0"
          :sx-post (unquote url) :sx-target "#block-editor" :sx-swap "outerHTML" :sx-disable "true"
          (unquote (if (= dir "") "" (quasiquote (input :type "hidden" :name "dir" :value (unquote dir)))))
          (button :type "submit" (unquote label)))))))
(define host/blog--block-row
  (fn (slug cslug)
    (let ((ctype (host/blog--primary-card-type cslug))
          (vals (host/blog-field-values-of cslug)))
      (quasiquote
        (li :style "display:flex;gap:0.5em;align-items:center;border:1px solid #ddd;padding:0.4em;margin:0.2em 0"
          (span :style "font-weight:bold;min-width:7em" (unquote ctype))
          (span :style "flex:1;color:#555" (unquote (host/blog--block-preview vals)))
          (a :href (unquote (str "/" cslug "/edit")) "fields")
          (unquote (host/blog--block-btn slug cslug "move" "up" "↑"))
          (unquote (host/blog--block-btn slug cslug "move" "down" "↓"))
          (unquote (host/blog--block-btn slug cslug "remove" "" "remove")))))))
(define host/blog--block-editor
  (fn (slug)
    (let ((refs (host/blog-body-refs slug)))
      (let ((rows (map (fn (c) (host/blog--block-row slug c)) refs))
            (type-opts (map (fn (ct) (quasiquote (option :value (unquote ct) (unquote ct))))
                            (list "card-heading" "card-text" "card-quote" "card-code" "card-callout"))))
        (quasiquote
          (div :id "block-editor" :style "margin-top:1.5em;border-top:1px solid #ccc;padding-top:1em"
            (h3 :style "font-size:1em;margin:0 0 0.3em" "Blocks")
            (unquote (if (> (len refs) 0) (cons (quote ul) rows) (quote (p :style "color:#999" "No blocks yet."))))
            (form :method "post" :action (unquote (str "/" slug "/blocks/add"))
              :sx-post (unquote (str "/" slug "/blocks/add")) :sx-target "#block-editor" :sx-swap "outerHTML"
              (select :name "ctype" (unquote (cons (quote span) type-opts)))
              " " (input :name "text" :placeholder "text…" :style "width:50%")
              " " (button :type "submit" "+ add block"))))))))

;; ── 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 (;; composition objects: a record with a :body renders via the render-fold
                  ;; (host/comp-render) against a context (auth from the principal); else the
                  ;; legacy sx_content path. The SAME object renders differently per context.
                  (body-html (if (get r :body)
                               (host/comp-render (get r :body) (host/blog--comp-ctx principal req))
                               (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)
    ;; only PUBLISHED posts list on the home page — drafts and "block" card objects
    ;; (the decomposed cards-as-objects) are stored but not surfaced as top-level posts.
    (let ((posts (filter (fn (p) (= (get p :status) "published")) (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"))))

;; ── typed Ghost import (the radar genesis-import seam) ──────────────
;; Import ONE Ghost post (a dict of its columns, string keys) as a TYPED host post:
;; the {slug,title,sx_content,status} record + is-a article + Ghost columns mapped onto
;; article :field-values (custom_excerpt->subtitle, feature_image->hero) + tags landed as
;; tag-posts with tagged edges. The Ghost body is ALREADY sx_content (the Python
;; lexical_to_sx migration produced (~kg_cards/kg-*) markup), so we just carry it. So an
;; old Ghost post lands not as bare markup but as a first-class typed Article — fields on
;; the edit form, subtitle as a rendered standfirst, tags in the graph. Idempotent
;; (put!/seed!/relate! are sets). Contract: plans/NOTE-blog-types-for-radar.md.
(define host/blog-import-post!
  (fn (gp)
    (let ((slug (get gp "slug")) (title (get gp "title")))
      (begin
        (host/blog-put! slug title (or (get gp "sx_content") "") (or (get gp "status") "published"))
        (host/blog-relate! slug "article" "is-a")
        (host/blog--set-field-values! slug
          {"subtitle" (or (get gp "custom_excerpt") (get gp "excerpt") "")
           "hero" (or (get gp "feature_image") "")})
        (for-each
          (fn (tag)
            (let ((tslug (host/blog-slugify tag)))
              (begin
                (host/blog-seed! tslug tag (str "(article (h1 \"" tag "\"))") "published")
                (host/blog-relate! tslug "tag" "is-a")
                (host/blog-relate! slug tslug "tagged"))))
          (or (get gp "tags") (list)))
        ;; cards-as-objects: decompose the Ghost body into card objects + a `contains`
        ;; body, so the post renders via the composition fold (its :body supersedes the
        ;; opaque sx_content). parse-safe degrades to nil on bad input -> decompose no-ops.
        (host/blog--decompose! slug (parse-safe (or (get gp "sx_content") "")))
        slug))))
;; Import a batch; returns the imported slugs.
(define host/blog-import-all!
  (fn (posts) (map host/blog-import-post! posts)))
;; POST /import — the genesis-import endpoint. Body = a text/sx LIST of Ghost post dicts
;; (radar's Postgres reader serialises rows to this); imports each as a typed post.
;; -> {:ok true :data {:imported N :slugs (...)}}. Guarded (admin). Runs in the serving
;; handler (IO resolver installed) so the per-post / per-tag loops are JIT-safe.
(define host/blog-import-handler
  (fn (req)
    (let ((raw (dream-body req)))
      (let ((posts (if (or (nil? raw) (= raw "")) (list) (sxtp/-normalize (parse-safe raw)))))
        (if (= (type-of posts) "list")
          (host/ok {:imported (len posts) :slugs (host/blog-import-all! posts)})
          (host/error 400 "expected a text/sx list of Ghost post dicts"))))))

;; 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")))))))

;; POST /<slug>/blocks/add|remove|move — structural edits to the post :body. Each does the
;; durable op then returns the re-rendered #block-editor (AJAX swap) or redirects (no-JS).
(define host/blog--block-resp
  (fn (req slug)
    (if (host/blog--editor-swap-req? req)
      (dream-html (render-page (host/blog--block-editor slug)))
      (dream-redirect (str "/" slug "/edit")))))
(define host/blog-block-add-submit
  (fn (req)
    (let ((slug (dream-param req "slug"))
          (ctype (or (host/field req "ctype") "card-text"))
          (text (or (host/field req "text") "")))
      (begin
        ;; ctype must be a card type — a subtype of "card" (card types are linked by
        ;; subtype-of, NOT is-a, so the down-closure of "card" is the valid set).
        (when (and (host/blog-exists? slug)
                   (contains? (host/blog--subtype-closure (list "card") :in) ctype))
          (host/blog-block-add! slug ctype
            (if (= ctype "card-heading") {"level" "2" "text" text} {"text" text})))
        (host/blog--block-resp req slug)))))
(define host/blog-block-remove-submit
  (fn (req)
    (let ((slug (dream-param req "slug")) (cslug (dream-param req "cslug")))
      (begin
        (when (host/blog-exists? slug) (host/blog-block-remove! slug cslug))
        (host/blog--block-resp req slug)))))
(define host/blog-block-move-submit
  (fn (req)
    (let ((slug (dream-param req "slug")) (cslug (dream-param req "cslug"))
          (dir (or (host/field req "dir") "up")))
      (begin
        (when (host/blog-exists? slug) (host/blog-block-move! slug cslug dir))
        (host/blog--block-resp req slug)))))

;; 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))
                  (block-editor (host/blog--block-editor 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 block-editor)
                      (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/blocks/add" (host/blog--protect-html resolve host/blog-block-add-submit))
      (dream-post "/:slug/blocks/:cslug/remove" (host/blog--protect-html resolve host/blog-block-remove-submit))
      (dream-post "/:slug/blocks/:cslug/move" (host/blog--protect-html resolve host/blog-block-move-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))
      (dream-post "/import" (host/blog--protect-html resolve host/blog-import-handler)))))

;; 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))))
