host: logged-in "add related" hint + filterable infinite-scroll relate picker

Make relating discoverable and pleasant: a hint on posts with no relations, and
a real candidate picker on the edit page.

- post page: when a post has no relations AND the viewer is logged in, show a
  subtle "No related posts yet — add some" hint linking to the edit page;
  anonymous viewers still see nothing.
- GET /<slug>/relate-options?q=&offset= — SX endpoint returning one page of
  candidate rows (HTML <li> fragment): every post except itself and ones already
  related, narrowed by q (case-insensitive title/slug substring), title-sorted,
  paginated by host/blog--picker-limit. Public read; the relate POST stays
  guarded.
- GET /relate-picker.js — small vanilla glue (debounced live filter +
  scroll-to-load-more) served from a route. The host serves static HTML (no SX
  island hydration), so the interactive layer is a cached script, not an island;
  data-slug on the input carries the post to it.
- edit page: the plain "slug to relate" box becomes a filter input + scrollable
  results list (#relate-filter/#relate-results) populated by the script; each row
  is a one-click relate form.

8 tests: endpoint lists/excludes-self/filters-by-q/excludes-already-related, JS
route content-type + glue, hint shown logged-in / hidden anonymous. 238/238.
Verified live: hint (logged-in only), candidate rows, q=filter, JS route
(node --check OK), edit picker UI with data-slug.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>

lib/host/blog.sx

@@ -115,6 +115,64 @@
           (map (fn (n) (substr (symbol->string n) 5))
             (filter (fn (n) (starts-with? (symbol->string n) "blog:")) kids)))))))
 
+;; ── 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)
+(define host/blog--relate-candidates
+  (fn (slug q)
+    (let ((already (host/blog-related slug))
+          (ql (lower (or q ""))))
+      (let ((cands
+              (filter
+                (fn (p)
+                  (and (not (= (get p :slug) slug))
+                       (not (contains? already (get p :slug)))
+                       (or (= ql "")
+                           (contains? (lower (get p :title)) ql)
+                           (contains? (get p :slug) ql))))
+                (host/blog-list))))
+        ;; 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 (POST /relate).
+(define host/blog--picker-item
+  (fn (slug p)
+    (quasiquote
+      (li :style "border-bottom:1px solid #eee"
+        (form :method "post" :style "margin:0"
+          :action (unquote (str "/" slug "/relate"))
+          (input :type "hidden" :name "other" :value (unquote (get p :slug)))
+          (button :type "submit"
+            :style "width:100%;text-align:left;background:none;border:none;padding:0.5em;cursor:pointer"
+            (unquote (get p :title))))))))
+
+;; GET /<slug>/relate-options?q=&offset= — one page of candidate rows as an HTML
+;; fragment (the <li>s the picker script appends). Public read (same data as
+;; /posts); the relate action itself stays guarded.
+(define host/blog-relate-options
+  (fn (req)
+    (let ((slug (dream-param req "slug"))
+          (q (or (dream-query-param req "q") ""))
+          (offset (host/query-int req "offset" 0)))
+      (let ((page (take (drop (host/blog--relate-candidates slug q) offset)
+                    host/blog--picker-limit)))
+        (dream-html
+          (join "" (map (fn (p) (render-page (host/blog--picker-item slug p))) page)))))))
+
+;; GET /relate-picker.js — progressive-enhancement glue for the edit-page picker:
+;; debounced live filter + scroll-to-load-more against /<slug>/relate-options. The
+;; host serves static HTML (no SX hydration), so the interactive layer is a small
+;; vanilla script served from this route (read once, cached).
+(define host/blog-picker-js-src
+  "(function(){var f=document.getElementById('relate-filter');if(!f)return;var r=document.getElementById('relate-results');var slug=f.getAttribute('data-slug'),off=0,q='',busy=false,done=false,t;function load(reset){if(busy||(!reset&&done))return;busy=true;if(reset){off=0;done=false;}fetch('/'+slug+'/relate-options?q='+encodeURIComponent(q)+'&offset='+off).then(function(x){return x.text();}).then(function(h){var d=document.createElement('div');d.innerHTML=h;var n=d.children.length;if(reset)r.innerHTML='';while(d.firstChild)r.appendChild(d.firstChild);off+=n;done=n<20;busy=false;}).catch(function(){busy=false;});}f.addEventListener('input',function(){clearTimeout(t);t=setTimeout(function(){q=f.value.trim();load(true);},200);});r.addEventListener('scroll',function(){if(r.scrollTop+r.clientHeight>=r.scrollHeight-40){load(false);}});load(true);})();")
+(define host/blog-picker-js
+  (fn (req)
+    (dream-response 200 {:content-type "application/javascript; charset=utf-8"}
+      host/blog-picker-js-src)))
+
 ;; ── 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
@@ -129,25 +187,33 @@
             (head (meta :charset "utf-8") (title (unquote title)))
             (body (unquote body))))))))
 
-;; "Related posts" block for the post page: a list of links, or "" when none.
+;; "Related posts" block for the post page: a list of links when there are any;
-;; Records (slug+title) are fetched up front so the SX tree is built from
+;; a subtle "add some" hint when there are none AND the viewer is logged in (an
-;; in-memory data — no durable read happens while the page tree is rendered.
+;; editor); nothing for an anonymous viewer. Records (slug+title) are fetched up
+;; front so the SX tree is built from in-memory data — no durable read happens
+;; while the page tree is rendered.
 (define host/blog--related-block
-  (fn (slug)
+  (fn (slug logged-in)
     (let ((rel (map (fn (s) {:slug s :title (get (host/blog-get s) :title)})
                  (host/blog-related slug))))
-      (if (> (len rel) 0)
+      (cond
-        (let ((items
+        ((> (len rel) 0)
-                (map (fn (p)
+          (let ((items
-                       (quasiquote
+                  (map (fn (p)
-                         (li (a :href (unquote (str "/" (get p :slug) "/"))
+                         (quasiquote
-                               (unquote (get p :title))))))
+                           (li (a :href (unquote (str "/" (get p :slug) "/"))
-                  rel)))
+                                 (unquote (get p :title))))))
+                    rel)))
+            (quasiquote
+              (div :style "margin-top:2em"
+                (h3 "Related posts")
+                (unquote (list (quote ul) items))))))
+        (logged-in
           (quasiquote
-            (div :style "margin-top:2em"
+            (p :style "margin-top:2em;font-size:0.9em;opacity:0.7"
-              (h3 "Related posts")
+              "No related posts yet — "
-              (unquote (list (quote ul) items)))))
+              (a :href (unquote (str "/" slug "/edit")) "add some") ".")))
-        ""))))
+        (else "")))))
 
 ;; Related-posts editor for the edit page: current links each with a remove
 ;; button, plus an "add related" box (relate by slug; the submit validates it).
@@ -169,10 +235,17 @@
                              (button :type "submit" "remove")))))
                   rel))
               (quote (p :style "opacity:0.7" "None yet."))))
-          (form :method "post" :action (unquote (str "/" slug "/relate"))
+          ;; add: a filterable, infinite-scrolling picker. The filter input + the
-            (input :name "other" :placeholder "slug to relate")
+          ;; results list are populated by /relate-picker.js (debounced filter,
-            " "
+          ;; scroll-to-load) hitting /<slug>/relate-options; each row's button
-            (button :type "submit" "Add related")))))))
+          ;; POSTs /relate. data-slug carries the post to the script.
+          (h4 :style "margin-bottom:0.3em" "Add related")
+          (input :type "text" :id "relate-filter" :data-slug (unquote slug)
+            :placeholder "filter posts…" :autocomplete "off"
+            :style "width:100%;padding:0.4em;box-sizing:border-box")
+          (ul :id "relate-results"
+            :style "list-style:none;padding:0;margin:0.5em 0;max-height:240px;overflow:auto;border:1px solid #ddd")
+          (raw! "<script src=\"/relate-picker.js\"></script>"))))))
 
 ;; ── read handlers ───────────────────────────────────────────────────
 ;; Post body is rendered per-block (a guarded HTML string) then injected raw.
@@ -185,7 +258,8 @@
           ;; quasiquote — host/blog--related-block does durable reads, and IO must
           ;; happen in the handler body, not while the page tree is being built.
           (let ((body-html (host/blog-render r))
-                (related-block (host/blog--related-block slug)))
+                (related-block (host/blog--related-block slug
+                                 (not (nil? (host/current-principal req))))))
             (dream-html
               (host/blog--page (get r :title)
                 (quasiquote
@@ -455,7 +529,9 @@
     (dream-get "/" host/blog-home)
     (dream-get "/posts" host/blog-index)
     (dream-get "/new" host/blog-new-form)
+    (dream-get "/relate-picker.js" host/blog-picker-js)
     (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.

lib/host/tests/blog.sx

@@ -249,6 +249,34 @@
     (contains? (host/blog-related "my-first-post") "another-one"))
   false)
 
+;; -- relate picker (filterable candidate endpoint + glue + hint) --
+(host/blog-put! "alpha-post" "Alpha Post" "(p \"a\")" "published")
+(host/blog-put! "beta-post" "Beta Post" "(p \"b\")" "published")
+(host/blog-put! "gamma-post" "Gamma Post" "(p \"g\")" "published")
+(host-bl-test "relate-options lists other posts"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/alpha-post/relate-options"))) "Beta Post") true)
+(host-bl-test "relate-options excludes the post itself"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/alpha-post/relate-options"))) ">Alpha Post<") false)
+(host-bl-test "relate-options filters by q (title substring)"
+  (let ((body (dream-resp-body (host-bl-app (host-bl-req "/alpha-post/relate-options?q=beta")))))
+    (list (contains? body "Beta Post") (contains? body "Gamma Post")))
+  (list true false))
+(host-bl-test "relate-options excludes already-related candidates"
+  (begin
+    (host/blog-relate! "alpha-post" "beta-post")
+    (contains? (dream-resp-body (host-bl-app (host-bl-req "/alpha-post/relate-options"))) "Beta Post"))
+  false)
+(host/blog-unrelate! "alpha-post" "beta-post")
+(host-bl-test "relate-picker.js served as javascript"
+  (dream-resp-header (host-bl-app (host-bl-req "/relate-picker.js")) "content-type")
+  "application/javascript; charset=utf-8")
+(host-bl-test "relate-picker.js carries the fetch glue"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/relate-picker.js"))) "relate-options") true)
+(host-bl-test "related block: hint when logged-in + no relations"
+  (contains? (str (host/blog--related-block "gamma-post" true)) "add some") true)
+(host-bl-test "related block: empty when anonymous + no relations"
+  (= (host/blog--related-block "gamma-post" false) "") true)
+
 ;; -- experimental unguarded create-only route (POST /new, no auth) --
 (define host-bl-oapp (host/make-app (list host/blog-open-create-routes host/blog-routes)))
 (host/blog-use-store! (persist/open))