;; 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         JSON list (public)     -> [{slug,title,status}]
;;   GET    /new           HTML create form (public chrome)
;;   POST   /new           form-urlencoded ingest from the editor (guarded)
;;   POST   /posts         JSON create (guarded)
;;   PUT    /posts/<slug>  JSON update (guarded)
;;   DELETE /posts/<slug>  delete (guarded)
;; Reads anonymous; writes behind the auth+ACL pipeline ("edit" on "blog").
;; 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)))

;; 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))))
(define host/blog-put!
  (fn (slug title sx-content status)
    (persist/backend-kv-put host/blog-store (host/blog--key slug)
      {: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))))

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

(define host/blog-rel-kinds
  (list
    {:kind "related" :label "Related posts" :symmetric true :candidates "all"}
    {:kind "is-a" :label "Types" :symmetric false :candidates "types"
                  :inverse-label "Instances"}
    {:kind "subtype-of" :label "Subtype of" :symmetric false :candidates "types"
                        :inverse-label "Subtypes"}
    {:kind "tagged" :label "Tags" :symmetric false :candidates "tags"
                    :inverse-label "Tagged with this"}))

;; registry lookup; nil for an unknown kind (relate validates against this)
(define host/blog--kind-spec
  (fn (kind)
    (reduce (fn (acc k) (if (= (get k :kind) kind) k acc)) nil host/blog-rel-kinds)))
(define host/blog--kind-symmetric?
  (fn (kind) (let ((s (host/blog--kind-spec kind))) (and s (get s :symmetric)))))

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

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

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

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

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

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

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

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

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

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

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

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

;; ── 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: declarative type schemas ───────────────────
;; A type may carry a SCHEMA: a list of rules {:block <tag> :msg <why>}, each
;; requiring the content to contain (anywhere) an element of that tag. 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 could later be stored ON the type-post.
(define host/blog-type-schemas
  {:article (list {:block "h1" :msg "an article needs a heading (h1)"})})
(define host/blog-schema-of (fn (type-slug) (get host/blog-type-schemas type-slug)))

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

(define host/blog--relate-candidates
  (fn (slug q kind)
    (let ((spec (host/blog--kind-spec kind)))
      (let ((pool (host/blog--candidate-pool kind))
            (already (host/blog-out slug kind))
            (ql (lower (or q ""))))
        ;; pool is slugs; resolve titles, drop self + already-linked, filter by q
        (let ((cands
                (filter
                  (fn (p)
                    (or (= ql "")
                        (contains? (lower (get p :title)) ql)
                        (contains? (get p :slug) ql)))
                  (map (fn (s) {:slug s :title (get (host/blog-get s) :title)})
                    (filter (fn (s) (and (not (= s slug)) (not (contains? already s)))) pool)))))
          ;; title-sort via [title slug] pairs (sort compares the title first)
          (map (fn (pair) {:slug (nth pair 1) :title (nth pair 0)})
            (sort (map (fn (p) (list (get p :title) (get p :slug))) cands))))))))

;; 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 (take (drop (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)
    ;; 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))
          ;; the results <ul>, server-rendered with the first page of candidates so a
          ;; re-rendered editor's picker is never briefly empty (the load trigger then
          ;; re-fetches the same page and morphs it in, invisibly). Built by cons so
          ;; the candidate li-trees splice in as children (the same pattern the current
          ;; list uses) — they can't be passed through a component arg (those evaluate).
          (results-ul
            (let ((cands (take (host/blog--relate-candidates slug "" kind)
                           host/blog--picker-limit)))
              (let ((rows (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)))))
                (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)
      (map (fn (spec) (host/blog--relation-editor slug (get spec :kind)))
        host/blog-rel-kinds))))

;; ── read handlers ───────────────────────────────────────────────────
;; Post body is rendered per-block (a guarded HTML string) then injected raw.
(define host/blog-post
  (fn (req)
    (let ((slug (dream-param req "slug")))
      (let ((r (host/blog-get slug)))
        (if r
          ;; Compute everything that does durable reads — body, related block, AND
          ;; the auth footer (a durable session read now) — in let bindings BEFORE
          ;; the quasiquote. IO must run in the handler body, never while the page
          ;; tree is built (a perform there raises VmSuspended under http-listen).
          (let ((principal (host/current-principal req)))
            (let ((body-html (host/blog-render r))
                  ;; all relation blocks (Related, Tags, Types, Tagged-with-this …)
                  ;; come from iterating the registry — one section, registry-driven.
                  (relations (host/blog--relations-or-hint slug (not (nil? principal))))
                  (auth-foot (host/auth-footer req)))
              (host/blog--resp req 200
                (host/blog--page req (get r :title)
                  (quasiquote
                    (div
                      (article (raw! (unquote body-html)))
                      (unquote relations)
                      (p :style "margin-top:2em;font-size:0.9em;opacity:0.8"
                        (a :href (unquote (str "/" slug "/source")) "view source")
                        " · "
                        (a :href (unquote (str "/" slug "/edit")) "edit")
                        " · "
                        (a :href "/" "all posts")
                        " · "
                        (unquote auth-foot))))))))
          (host/blog--resp req 404
            (host/blog--page req "Not found"
              (quasiquote
                (div (h1 "404")
                  (p (unquote (str "No published post: " slug))))))))))))

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

;; 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 (dream-form-field req "title"))
          (sx-content (dream-form-field req "sx_content"))
          (status (or (dream-form-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 "/")))))))))

;; POST /posts — JSON create {slug?,title,sx_content,status}. 409 if slug exists.
(define host/blog-create
  (fn (req)
    (let ((p (dream-json-body req)))
      (if (= (type-of p) "dict")
        (let ((title (get p :title)))
          (cond
            ((or (nil? title) (= title "")) (host/error 400 "title required"))
            ((not (host/blog-content-ok? (get p :sx_content)))
              (host/error 400 "invalid sx_content"))
            (else
              (let ((slug (or (get p :slug) (host/blog-slugify title))))
                (if (host/blog-exists? slug)
                  (host/error 409 "post already exists")
                  (begin
                    (host/blog-put! slug title (or (get p :sx_content) "")
                      (or (get p :status) "published"))
                    (host/ok-status 201 {:slug slug :title title})))))))
        (host/error 400 "invalid payload")))))

;; PUT /posts/<slug> — JSON update {title?,sx_content?,status?}. 404 if absent.
(define host/blog-update-handler
  (fn (req)
    (let ((slug (dream-param req "slug")) (p (dream-json-body req)))
      (if (= (type-of p) "dict")
        (let ((r (host/blog-get slug)))
          (cond
            ((nil? r) (host/error 404 "no such post"))
            ((not (host/blog-content-ok? (get p :sx_content)))
              (host/error 400 "invalid sx_content"))
            (else
              (begin
                (host/blog-put! slug
                  (or (get p :title) (get r :title))
                  (or (get p :sx_content) (get r :sx-content))
                  (or (get p :status) (get r :status)))
                (host/ok {:slug slug :updated true})))))
        (host/error 400 "invalid payload")))))

;; DELETE /posts/<slug>
;; drop every edge touching `slug`, across all kinds + both directions, so a
;; deleted post leaves no dangling links anywhere in the graph.
(define host/blog--drop-all-edges!
  (fn (slug)
    (for-each
      (fn (spec)
        (let ((kind (get spec :kind)))
          (begin
            (for-each (fn (o) (host/blog-unrelate! slug o kind)) (host/blog-out slug kind))
            (for-each (fn (o) (host/blog-unrelate! o slug kind)) (host/blog-in slug kind)))))
      host/blog-rel-kinds)))

(define host/blog-delete-handler
  (fn (req)
    (let ((slug (dream-param req "slug")))
      (if (host/blog-exists? slug)
        (begin
          (host/blog--drop-all-edges! slug)
          (host/blog-delete! slug)
          (host/ok {:slug slug :deleted true}))
        (host/error 404 "no such post")))))

;; 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 (dream-form-field req "other"))
          (kind (or (dream-form-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
          (when (and other (not (= other "")) (not (= other slug))
                     (host/blog--kind-spec kind) (host/blog-exists? 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)))
            (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 (dream-form-field req "other"))
          (kind (or (dream-form-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)))
          (dream-redirect (str "/" slug "/edit")))))))

;; GET /<slug>/edit — edit form pre-filled with the post's current title, raw
;; sx_content (in a textarea — render-to-html escapes the text child, so the
;; browser shows the source verbatim), and status (current value pre-selected).
;; Guarded: only an editor reaches the editor. Keeps the slug (edits don't re-slug).
(define host/blog-edit-form
  (fn (req)
    (let ((slug (dream-param req "slug")))
      (let ((r (host/blog-get slug)))
        (if (nil? r)
          (host/blog--resp req 404
            (host/blog--page req "Not found"
              (quasiquote (div (h1 "404") (p (unquote (str "No post: " slug)))))))
          (let ((status (get r :status)))
            ;; the relation editors + tag toggle do durable reads — compute them
            ;; here, not in the quasiquote, so IO stays in the handler body.
            (let ((relation-editors (host/blog--relation-editors slug))
                  (tag-toggle (host/blog--is-tag-toggle slug))
                  (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) ""))))
                        (p (select :name "status"
                             (unquote (mk-opt "draft" "Draft"))
                             (unquote (mk-opt "published" "Published")))
                          " "
                          (button :type "submit" "Save")))
                      (div :style "margin-top:2em;border-top:1px solid #ccc;padding-top:1em"
                        (unquote tag-toggle))
                      (unquote relation-editors)
                      (p :style "margin-top:1.5em"
                        (a :href (unquote (str "/" slug "/")) "view post")
                        " · "
                        (a :href (unquote (str "/" slug "/source")) "view source")))))))))))))

;; POST /<slug>/edit — save the edited source. Same write-time validation as the
;; create paths (unparseable body -> 400, post left intact). Slug is preserved.
(define host/blog-edit-submit
  (fn (req)
    (let ((slug (dream-param req "slug")) (r (host/blog-get (dream-param req "slug"))))
      (if (nil? r)
        (host/blog--resp req 404
          (host/blog--page req "Not found"
            (quasiquote (div (h1 "404") (p (unquote (str "No post: " slug)))))))
        (let ((title (or (dream-form-field req "title") (get r :title)))
              (sx-content (or (dream-form-field req "sx_content") ""))
              (status (or (dream-form-field req "status") (get r :status))))
          ;; 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)
                (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 "/:slug/source" host/blog-source)
    (dream-get "/:slug/relate-options" host/blog-relate-options)
    (dream-get "/:slug" host/blog-post)))

;; Guarded writes: form ingest + JSON create/update/delete behind auth+ACL.
;; NB: helper is host/blog--protect, NOT `guard` (reserved special form).
(define host/blog--protect
  (fn (resolve h)
    (host/pipeline
      (list
        host/wrap-errors
        (host/require-user resolve)
        (host/require-permission "edit" (fn (req) "blog")))
      h)))
;; Browser variant: identical ACL gate, but an unauthenticated request REDIRECTS
;; to the login page (host/require-login) rather than returning a raw JSON 401 —
;; the form/edit pages are HTML, so a logged-out click should land on /login and
;; return here afterwards.
(define host/blog--protect-html
  (fn (resolve h)
    (host/pipeline
      (list
        host/wrap-errors
        (host/require-login resolve)
        (host/require-permission "edit" (fn (req) "blog")))
      h)))
(define host/blog-write-routes
  (fn (resolve)
    (list
      (dream-post "/new" (host/blog--protect-html resolve host/blog-form-submit))
      (dream-get "/:slug/edit" (host/blog--protect-html resolve host/blog-edit-form))
      (dream-post "/:slug/edit" (host/blog--protect-html resolve host/blog-edit-submit))
      (dream-post "/:slug/relate" (host/blog--protect-html resolve host/blog-relate-submit))
      (dream-post "/:slug/unrelate" (host/blog--protect-html resolve host/blog-unrelate-submit))
      (dream-post "/posts" (host/blog--protect resolve host/blog-create))
      (dream-put "/posts/:slug" (host/blog--protect resolve host/blog-update-handler))
      (dream-delete "/posts/:slug" (host/blog--protect resolve host/blog-delete-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))))