host: relate/unrelate keep both lists in sync (add to current list, never blank the picker)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s

Two reported bugs on the edit page's relation editor:
 1. relating a candidate didn't add it to the current-relations list (the AJAX
    relate just deleted the candidate row; the relation only showed after a reload);
 2. removing a relation could blank the relate picker.

Fix (lib/host/blog.sx): both the candidate's relate form and a current relation's
remove form now target #rel-editor-<kind> with sx-swap=outerHTML, and the
relate/unrelate handlers return the re-rendered editor for that kind (current list +
a fresh picker). So one swap keeps BOTH lists in sync: the related post moves into
the current list and out of the (re-loaded) candidate pool; removing moves it back.
Gated on the SX-Target header, so a plain boosted form / no-JS POST (the is-a-tag
toggle) still redirects + re-renders #content.

Engine fix (web/orchestration.sx): handle-html-response's non-select branch called
post-swap on the OLD target, which an outerHTML swap has already REPLACED — so the
swapped-in content's triggers (here the re-rendered picker's "load") never bound and
the picker stayed empty. post-swap the swap result (the new node), mirroring the
sx-select branch. Recompiled orchestration.sxbc for the content-addressed client.

Tests:
 - web/tests/test-relate-picker.sx: relating re-syncs the editor (post in current
   list + picker re-loads); removing does likewise — both fail without the engine fix.
 - lib/host/tests/blog.sx: relate/unrelate return the re-rendered editor fragment
   (200, #rel-editor + picker), forms wire to #rel-editor-KIND/outerHTML, plain
   boosted POST still 303.
 - relate-picker.spec.js: the full in-page flow (relate adds to list, remove keeps
   the picker, no reload) + persistence.

Verified: host conformance 277/277, web engine suite 8/8, run-picker-check 3/3,
run-spa-check 3/3.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
2026-06-29 19:53:20 +00:00
parent 09465f4483
commit 268e91cd5d
7 changed files with 248 additions and 135 deletions

View File

@@ -364,16 +364,18 @@
(quasiquote (quasiquote
(li :id (unquote (str "cand-" kind "-" (get p :slug))) (li :id (unquote (str "cand-" kind "-" (get p :slug)))
:style "border-bottom:1px solid #eee" :style "border-bottom:1px solid #eee"
;; AJAX relate: sx-post the relation, then sx-swap="delete" removes THIS ;; AJAX relate: sx-post the relation, then sx-swap="outerHTML" re-renders the
;; candidate row (its sx-target) — it's now related, so it leaves the pool ;; WHOLE relation editor for this kind (its sx-target #rel-editor-KIND) — the
;; without a reload or a list refetch. method+action stay for the no-JS ;; just-related post moves into the current-relations list and out of the
;; fallback (plain POST -> 303 -> reload); the engine prevents the double ;; candidate pool, and the fresh picker re-loads its candidates. (A bare
;; submit when it handles sx-post. ;; 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" (form :method "post" :style "margin:0"
:action (unquote (str "/" slug "/relate")) :action (unquote (str "/" slug "/relate"))
:sx-post (unquote (str "/" slug "/relate")) :sx-post (unquote (str "/" slug "/relate"))
:sx-target (unquote (str "#cand-" kind "-" (get p :slug))) :sx-target (unquote (str "#rel-editor-" kind))
:sx-swap "delete" :sx-swap "outerHTML"
(input :type "hidden" :name "other" :value (unquote (get p :slug))) (input :type "hidden" :name "other" :value (unquote (get p :slug)))
(input :type "hidden" :name "kind" :value (unquote kind)) (input :type "hidden" :name "kind" :value (unquote kind))
(button :type "submit" (button :type "submit"
@@ -434,11 +436,12 @@
;; so the blog degrades gracefully to plain server-rendered pages. ;; so the blog degrades gracefully to plain server-rendered pages.
(define host/blog--spa-req? (fn (req) (= (dream-header req "sx-request") "true"))) (define host/blog--spa-req? (fn (req) (= (dream-header req "sx-request") "true")))
;; An AJAX in-place row delete vs. a plain boosted form. The engine sends an ;; An AJAX editor swap (the picker's relate / the editor's remove) vs. a plain
;; SX-Target header for an sx-post form (the relation-editor's remove button, ;; boosted form. The engine sends an SX-Target header for an sx-post form
;; sx-target=#cur-…), but NOT for a plain boosted form (the is-a-tag toggle). So ;; (sx-target=#rel-editor-…), but NOT for a plain boosted form (the is-a-tag
;; this tells "delete just this row, empty 200" apart from "redirect + re-render". ;; toggle). So this tells "return the re-rendered editor fragment" apart from
(define host/blog--row-swap-req? ;; "redirect + re-render #content" (the toggle / no-JS path).
(define host/blog--editor-swap-req?
(fn (req) (fn (req)
(and (host/blog--spa-req? req) (and (host/blog--spa-req? req)
(let ((t (dream-header req "sx-target"))) (and t (not (= t ""))))))) (let ((t (dream-header req "sx-target"))) (and t (not (= t "")))))))
@@ -591,25 +594,30 @@
(let ((spec (host/blog--kind-spec kind)) (let ((spec (host/blog--kind-spec kind))
(current (host/blog-out slug kind))) (current (host/blog-out slug kind)))
(quasiquote (quasiquote
(div :style "margin-top:2em;border-top:1px solid #ccc;padding-top:1em" ;; #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))) (h3 (unquote (get spec :label)))
(unquote (unquote
(if (> (len current) 0) (if (> (len current) 0)
(cons (quote ul) (cons (quote ul)
(map (fn (s) (map (fn (s)
(quasiquote (quasiquote
;; AJAX unrelate: sx-post the removal, then sx-swap="delete" ;; remove: sx-post the unrelate, then sx-swap="outerHTML"
;; removes just THIS current-relation row (its sx-target) in ;; re-renders this kind's editor (its sx-target
;; place — NO #content re-render, so the relate picker (the ;; #rel-editor-KIND) — the row leaves the current list and
;; "posts to relate" list) is left untouched. method+action ;; the post returns to the candidate pool, both in sync,
;; stay for the no-JS fallback (plain POST -> 303 -> reload). ;; with the picker NOT cleared. method+action stay for no-JS.
(li :id (unquote (str "cur-" kind "-" s)) (li (a :href (unquote (str "/" s "/")) (unquote s)) " "
(a :href (unquote (str "/" s "/")) (unquote s)) " "
(form :method "post" :style "display:inline" (form :method "post" :style "display:inline"
:action (unquote (str "/" slug "/unrelate")) :action (unquote (str "/" slug "/unrelate"))
:sx-post (unquote (str "/" slug "/unrelate")) :sx-post (unquote (str "/" slug "/unrelate"))
:sx-target (unquote (str "#cur-" kind "-" s)) :sx-target (unquote (str "#rel-editor-" kind))
:sx-swap "delete" :sx-swap "outerHTML"
(input :type "hidden" :name "other" :value (unquote s)) (input :type "hidden" :name "other" :value (unquote s))
(input :type "hidden" :name "kind" :value (unquote kind)) (input :type "hidden" :name "kind" :value (unquote kind))
(button :type "submit" "remove"))))) (button :type "submit" "remove")))))
@@ -889,11 +897,13 @@
(when (and other (not (= other "")) (not (= other slug)) (when (and other (not (= other "")) (not (= other slug))
(host/blog--kind-spec kind) (host/blog-exists? other)) (host/blog--kind-spec kind) (host/blog-exists? other))
(host/blog-relate! slug other kind)) (host/blog-relate! slug other kind))
;; AJAX (the picker's sx-post): return an empty 200 so the candidate ;; AJAX (the picker's sx-post, carries SX-Target): return the re-rendered
;; form's sx-swap="delete" removes just that one row — no full reload, ;; editor for this kind so its sx-swap="outerHTML" replaces #rel-editor-KIND
;; no candidate-list refetch. Plain POST (no-JS) still redirects. ;; — the just-related post shows in the current list and the picker refreshes
(if (host/blog--spa-req? req) ;; its candidates. text/html so the client's DOMParser swap path renders the
(dream-html "") ;; 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")))))))) (dream-redirect (str "/" slug "/edit"))))))))
;; POST /<slug>/unrelate — remove the relation to `other` under `kind` (default ;; POST /<slug>/unrelate — remove the relation to `other` under `kind` (default
@@ -906,12 +916,13 @@
(begin (begin
(when (and other (not (= other "")) (host/blog--kind-spec kind)) (when (and other (not (= other "")) (host/blog--kind-spec kind))
(host/blog-unrelate! slug other kind)) (host/blog-unrelate! slug other kind))
;; AJAX in-place remove (the editor's sx-post, carries SX-Target): return an ;; AJAX remove (the editor's sx-post, carries SX-Target): return the
;; empty 200 so the current-relation row's sx-swap="delete" removes just that ;; re-rendered editor for this kind so its sx-swap="outerHTML" replaces
;; one row — no #content re-render, so the relate picker is untouched. A plain ;; #rel-editor-KIND — the row leaves the current list, the post returns to the
;; boosted form (the tag toggle) or a no-JS POST still redirects + re-renders. ;; (re-loaded) candidate pool, and the picker is NOT cleared. A plain boosted
(if (host/blog--row-swap-req? req) ;; form (the tag toggle) or a no-JS POST still redirects + re-renders #content.
(dream-html "") (if (host/blog--editor-swap-req? req)
(dream-html (render-page (host/blog--relation-editor slug kind)))
(dream-redirect (str "/" slug "/edit"))))))) (dream-redirect (str "/" slug "/edit")))))))
;; GET /<slug>/edit — edit form pre-filled with the post's current title, raw ;; GET /<slug>/edit — edit form pre-filled with the post's current title, raw

View File

@@ -50,28 +50,53 @@ async function login(page) {
} }
test.describe('relate picker (browser-only)', () => { test.describe('relate picker (browser-only)', () => {
test('the remove button on a current relation actually unrelates it', async ({ page }) => { test('relating a candidate adds it to the current list AND removing keeps the picker', async ({ page }) => {
// The whole in-page flow the user reported broken — no reloads. Relating a
// candidate re-renders the editor: the post moves into the current-relations
// list and the picker re-loads its candidates (it is NOT blanked). Removing it
// re-renders the editor back: the post leaves the current list and the picker
// still offers candidates.
test.setTimeout(75000); test.setTimeout(75000);
await loginTo(page, `/${HOST}/edit`); await loginTo(page, `/${HOST}/edit`);
await waitReady(page); await waitReady(page);
// relate Item 13 via the picker, then reload so it shows in the current list await page.evaluate(() => { window.__noReload = true; });
// relate Item 13 from the picker
await page.fill(RELF, 'Item 13'); await page.fill(RELF, 'Item 13');
await expect.poll(() => page.locator(RELROWS).count(), { timeout: 10000 }).toBe(1); await expect.poll(() => page.locator(RELROWS).count(), { timeout: 10000 }).toBe(1);
await page.locator(`${RELROWS} button`).first().click(); await page.locator(`${RELROWS} button`).first().click();
await expect.poll(() => page.locator(RELROWS).count(), { timeout: 10000 }).toBe(0); const relLink = page.locator('a[href="/picker-item-13/"]');
// ISSUE 1: it now appears in the CURRENT relations list (added, not just removed)
await expect(relLink).toHaveCount(1, { timeout: 12000 });
// and the re-rendered picker still offers candidates (not blanked)
await expect.poll(() => page.locator(RELROWS).count(), { timeout: 12000 }).toBeGreaterThan(0);
// now remove it via its current-list remove button
await page.locator('li:has(a[href="/picker-item-13/"]) button').click();
await expect(relLink).toHaveCount(0, { timeout: 12000 }); // left the current list
// ISSUE 2: removing must NOT clear "the list of posts to relate"
await expect.poll(() => page.locator(RELROWS).count(), { timeout: 12000 }).toBeGreaterThan(0);
expect(await page.evaluate(() => window.__noReload)).toBe(true); // all in-page, no reload
// and the relation truly persisted gone (reload shows it not present)
await page.reload(); await page.reload();
await waitReady(page); await waitReady(page);
const relLink = page.locator('a[href="/picker-item-13/"]'); await expect(page.locator('a[href="/picker-item-13/"]')).toHaveCount(0);
await expect(relLink).toHaveCount(1); // current relation present });
// the picker is populated (empty filter -> first page of candidates)
await expect.poll(() => page.locator(RELROWS).count(), { timeout: 12000 }).toBeGreaterThan(0); test('relating a candidate persists the relation', async ({ page }) => {
// click its remove button test.setTimeout(75000);
await page.locator('li:has(a[href="/picker-item-13/"]) button').click(); await loginTo(page, `/${HOST}/edit`);
await expect(relLink).toHaveCount(0, { timeout: 12000 }); // relation removed await waitReady(page);
// REGRESSION: removing a relation must NOT clear "the list of posts to relate". await page.fill(RELF, 'Item 07');
// (The old plain-boosted remove form redirected -> re-rendered #content and the await expect.poll(() => page.locator(RELROWS).count(), { timeout: 10000 }).toBe(1);
// picker came back empty; the AJAX in-place remove leaves the picker untouched.) await page.locator(`${RELROWS} button`).first().click();
await expect.poll(() => page.locator(RELROWS).count(), { timeout: 12000 }).toBeGreaterThan(0); await expect(page.locator('a[href="/picker-item-07/"]')).toHaveCount(1, { timeout: 12000 });
// persisted across a reload
await page.reload();
await waitReady(page);
await expect(page.locator('a[href="/picker-item-07/"]')).toHaveCount(1);
// and visible on the public post page
await page.goto(`/${HOST}/`);
await expect(page.getByRole('heading', { name: 'Related posts' })).toBeVisible();
await expect(page.locator('body')).toContainText('Picker Item 07');
}); });
test('picker populates after a boosted SPA nav to the edit page', async ({ page }) => { test('picker populates after a boosted SPA nav to the edit page', async ({ page }) => {

View File

@@ -296,34 +296,63 @@
(contains? (dream-resp-body (host-bl-app (host-bl-req "/alpha-post/relate-options"))) "rp-more") (contains? (dream-resp-body (host-bl-app (host-bl-req "/alpha-post/relate-options"))) "rp-more")
false) false)
;; -- unrelate: AJAX in-place row delete (regression: removing a related post must ;; -- relate / unrelate keep BOTH lists in sync by re-rendering the kind's editor.
;; NOT clear the relate picker). The remove button is now an sx-post form that ;; Regressions: (1) relating a candidate must ADD it to the current-relations
;; deletes just its own current-relation row (sx-target=#cur-…, sx-swap=delete), ;; list (not just delete the candidate row); (2) removing must NOT clear the
;; so #content is never re-rendered and the picker is left intact. -- ;; relate picker. Both the candidate's relate form and the remove form target
;; #rel-editor-KIND with sx-swap=outerHTML; the handler returns the re-rendered
;; editor, so the current list updates and the fresh picker re-loads. --
(host/blog-relate! "alpha-post" "beta-post" "related") (host/blog-relate! "alpha-post" "beta-post" "related")
(host-bl-test "relation-editor remove button is an AJAX in-place delete" ;; the editor wraps current list + picker in #rel-editor-KIND; remove re-renders it
(host-bl-test "relation-editor wires remove to re-render the kind's editor"
(let ((html (render-page (host/blog--relation-editor "alpha-post" "related")))) (let ((html (render-page (host/blog--relation-editor "alpha-post" "related"))))
(list (contains? html "id=\"cur-related-beta-post\"") ;; row has a target id (list (contains? html "id=\"rel-editor-related\"") ;; the swap target
(contains? html "sx-post=\"/alpha-post/unrelate\"") ;; AJAX, not plain post (contains? html "sx-post=\"/alpha-post/unrelate\"") ;; AJAX, not plain post
(contains? html "sx-target=\"#cur-related-beta-post\"") (contains? html "sx-target=\"#rel-editor-related\"")
(contains? html "sx-swap=\"delete\""))) (contains? html "sx-swap=\"outerHTML\"")))
(list true true true true)) (list true true true true))
;; the AJAX remove (carries SX-Target) returns an empty 200 so only the row is ;; the candidate's relate form targets the SAME editor (so relating re-renders it)
;; swapped out — no redirect, no #content re-render that would blank the picker. (host-bl-test "picker candidate relate form re-renders the kind's editor"
(host-bl-test "unrelate (AJAX, SX-Target) returns an empty 200" (let ((html (render-page (host/blog--picker-item "alpha-post" {:slug "gamma-post" :title "Gamma"} "related"))))
(list (contains? html "sx-post=\"/alpha-post/relate\"")
(contains? html "sx-target=\"#rel-editor-related\"")
(contains? html "sx-swap=\"outerHTML\"")))
(list true true true))
;; a POST request to a /:slug/… route, with the :slug route param populated (which
;; the route matcher would set) plus headers + a form body.
(define host-bl-relreq
(fn (slug action headers other kind)
(merge (dream-request "POST" (str "/" slug "/" action) headers
(str "other=" other "&kind=" kind))
{:params {:slug slug}})))
;; the AJAX remove (carries SX-Target) returns the re-rendered editor fragment (200,
;; with the #rel-editor wrapper + the picker) — not an empty body or a redirect.
(host-bl-test "unrelate (AJAX, SX-Target) returns the re-rendered editor fragment"
(let ((resp (host/blog-unrelate-submit (let ((resp (host/blog-unrelate-submit
(dream-request "POST" "/alpha-post/unrelate" (host-bl-relreq "alpha-post" "unrelate"
{:sx-request "true" :sx-target "#cur-related-beta-post"} {:sx-request "true" :sx-target "#rel-editor-related"}
"other=beta-post&kind=related")))) "beta-post" "related"))))
(list (dream-status resp) (dream-resp-body resp))) (list (dream-status resp)
(list 200 "")) (contains? (dream-resp-body resp) "rel-editor-related")
(contains? (dream-resp-body resp) "relate-picker")))
(list 200 true true))
;; relate (AJAX, SX-Target) likewise returns the editor with the new relation listed
(host/blog-unrelate! "alpha-post" "gamma-post" "related") ;; clean state
(host-bl-test "relate (AJAX, SX-Target) returns the editor showing the new relation"
(let ((resp (host/blog-relate-submit
(host-bl-relreq "alpha-post" "relate"
{:sx-request "true" :sx-target "#rel-editor-related"}
"gamma-post" "related"))))
(list (dream-status resp)
(contains? (dream-resp-body resp) "/gamma-post/"))) ;; now in the current list
(list 200 true))
(host/blog-unrelate! "alpha-post" "gamma-post" "related")
;; a plain boosted form / no-JS POST (no SX-Target) still redirects + re-renders, ;; a plain boosted form / no-JS POST (no SX-Target) still redirects + re-renders,
;; so the is-a-tag toggle and graceful degradation are unaffected. ;; so the is-a-tag toggle and graceful degradation are unaffected.
(host/blog-relate! "alpha-post" "beta-post" "related")
(host-bl-test "unrelate (plain boosted / no-JS, no SX-Target) still redirects" (host-bl-test "unrelate (plain boosted / no-JS, no SX-Target) still redirects"
(dream-status (host/blog-unrelate-submit (dream-status (host/blog-unrelate-submit
(dream-request "POST" "/alpha-post/unrelate" (host-bl-relreq "alpha-post" "unrelate"
{:sx-request "true"} "other=beta-post&kind=related"))) {:sx-request "true"} "beta-post" "related")))
303) 303)
(host/blog-unrelate! "alpha-post" "beta-post" "related") (host/blog-unrelate! "alpha-post" "beta-post" "related")
(host/blog-put! "hint-post" "Hint Post" "(p \"h\")" "published") (host/blog-put! "hint-post" "Hint Post" "(p \"h\")" "published")

View File

@@ -467,11 +467,19 @@
use-transition use-transition
(fn (fn
() ()
(swap-dom-nodes ;; post-swap the NEW node, not the old target — an outerHTML
target ;; swap REPLACES target, so processing target would re-bind a
(children-to-fragment container) ;; detached node and leave the swapped-in content's triggers
swap-style) ;; (e.g. a re-rendered picker's "load") unbound. Mirrors the
(post-swap target)))))))))) ;; sx-select branch above. For innerHTML swap-root falls back
;; to target (still in the document).
(let
((swap-root
(swap-dom-nodes
target
(children-to-fragment container)
swap-style)))
(post-swap (or swap-root target))))))))))))
(define (define
handle-retry handle-retry
:effects (mutation io) :effects (mutation io)

File diff suppressed because one or more lines are too long

View File

@@ -467,11 +467,19 @@
use-transition use-transition
(fn (fn
() ()
(swap-dom-nodes ;; post-swap the NEW node, not the old target — an outerHTML
target ;; swap REPLACES target, so processing target would re-bind a
(children-to-fragment container) ;; detached node and leave the swapped-in content's triggers
swap-style) ;; (e.g. a re-rendered picker's "load") unbound. Mirrors the
(post-swap target)))))))))) ;; sx-select branch above. For innerHTML swap-root falls back
;; to target (still in the document).
(let
((swap-root
(swap-dom-nodes
target
(children-to-fragment container)
swap-style)))
(post-swap (or swap-root target))))))))))))
(define (define
handle-retry handle-retry
:effects (mutation io) :effects (mutation io)

View File

@@ -24,7 +24,8 @@
(define _mock-fetch-ok true) (define _mock-fetch-ok true)
(define _mock-fetch-status 200) (define _mock-fetch-status 200)
(define _mock-fetch-ct "text/html; charset=utf-8") (define _mock-fetch-ct "text/html; charset=utf-8")
(define _mock-fetch-body "") (define _mock-fetch-body "") ;; the GET /relate-options (picker) response
(define _mock-editor-body "") ;; the POST /relate|/unrelate (editor) response
(define _mock-fetch-fail false) (define _mock-fetch-fail false)
(define reset-fetch-mock! (define reset-fetch-mock!
@@ -34,16 +35,20 @@
(set! _mock-fetch-status 200) (set! _mock-fetch-status 200)
(set! _mock-fetch-ct "text/html; charset=utf-8") (set! _mock-fetch-ct "text/html; charset=utf-8")
(set! _mock-fetch-body "") (set! _mock-fetch-body "")
(set! _mock-editor-body "")
(set! _mock-fetch-fail false))) (set! _mock-fetch-fail false)))
;; URL-aware mock: the picker GETs relate-options (returns candidate rows); a relate
;; or unrelate POST returns the re-rendered editor fragment.
(define fetch-request (define fetch-request
(fn (config success-fn error-fn) (fn (config success-fn error-fn)
(set! _mock-fetch-calls (+ _mock-fetch-calls 1)) (set! _mock-fetch-calls (+ _mock-fetch-calls 1))
(if _mock-fetch-fail (if _mock-fetch-fail
(error-fn "network error") (error-fn "network error")
(success-fn _mock-fetch-ok _mock-fetch-status (let ((url (or (get config "url") "")))
(fn (name) (if (= name "content-type") _mock-fetch-ct nil)) (success-fn _mock-fetch-ok _mock-fetch-status
_mock-fetch-body)))) (fn (name) (if (= name "content-type") _mock-fetch-ct nil))
(if (contains? url "relate-options") _mock-fetch-body _mock-editor-body))))))
;; ── harness platform shims ────────────────────────────────────────── ;; ── harness platform shims ──────────────────────────────────────────
;; Reactive hydration + island disposal live in web/boot.sx (the browser boot ;; Reactive hydration + island disposal live in web/boot.sx (the browser boot
@@ -121,38 +126,57 @@
"<ul id=\"rp-" kind "-results\" class=\"rp-results\"></ul>" "<ul id=\"rp-" kind "-results\" class=\"rp-results\"></ul>"
"</form>"))) "</form>")))
;; One candidate row, as host/blog--picker-item renders it. ;; One candidate row, as host/blog--picker-item renders it: relating re-renders the
;; whole editor (sx-target=#rel-editor-KIND, sx-swap=outerHTML).
(define row-html (define row-html
(fn (slug kind cand title) (fn (slug kind cand title)
(str (str
"<li id=\"cand-" kind "-" cand "\">" "<li id=\"cand-" kind "-" cand "\">"
"<form method=\"post\" action=\"/" slug "/relate\"" "<form method=\"post\" action=\"/" slug "/relate\""
" sx-post=\"/" slug "/relate\"" " sx-post=\"/" slug "/relate\""
" sx-target=\"#cand-" kind "-" cand "\"" " sx-target=\"#rel-editor-" kind "\""
" sx-swap=\"delete\">" " sx-swap=\"outerHTML\">"
"<input type=\"hidden\" name=\"other\" value=\"" cand "\">" "<input type=\"hidden\" name=\"other\" value=\"" cand "\">"
"<input type=\"hidden\" name=\"kind\" value=\"" kind "\">" "<input type=\"hidden\" name=\"kind\" value=\"" kind "\">"
"<button type=\"submit\">" title "</button>" "<button type=\"submit\">" title "</button>"
"</form>" "</form>"
"</li>"))) "</li>")))
;; One CURRENT-relation row, as host/blog--relation-editor renders it: an AJAX ;; One CURRENT-relation row, as host/blog--relation-editor renders it: removing
;; in-place remove (sx-post + sx-target=#cur-… + sx-swap=delete). ;; re-renders the whole editor (sx-target=#rel-editor-KIND, sx-swap=outerHTML).
(define cur-row-html (define cur-row-html
(fn (slug kind other label) (fn (slug kind other label)
(str (str
"<li id=\"cur-" kind "-" other "\">" "<li>"
"<a href=\"/" other "/\">" label "</a> " "<a href=\"/" other "/\">" label "</a> "
"<form method=\"post\" action=\"/" slug "/unrelate\"" "<form method=\"post\" action=\"/" slug "/unrelate\""
" sx-post=\"/" slug "/unrelate\"" " sx-post=\"/" slug "/unrelate\""
" sx-target=\"#cur-" kind "-" other "\"" " sx-target=\"#rel-editor-" kind "\""
" sx-swap=\"delete\">" " sx-swap=\"outerHTML\">"
"<input type=\"hidden\" name=\"other\" value=\"" other "\">" "<input type=\"hidden\" name=\"other\" value=\"" other "\">"
"<input type=\"hidden\" name=\"kind\" value=\"" kind "\">" "<input type=\"hidden\" name=\"kind\" value=\"" kind "\">"
"<button type=\"submit\">remove</button>" "<button type=\"submit\">remove</button>"
"</form>" "</form>"
"</li>"))) "</li>")))
;; The kind's relation editor: #rel-editor-KIND wrapping the current-relations list
;; and the picker (with `candidates` already in its results <ul>). This is what the
;; relate/unrelate handlers return and what the initial edit page renders.
(define editor-html
(fn (kind current candidates)
(str
"<div id=\"rel-editor-" kind "\">"
"<h3>" kind "</h3>"
"<ul class=\"rp-current\">" current "</ul>"
"<form class=\"relate-picker\" data-slug=\"host\" data-kind=\"" kind "\""
" sx-get=\"/host/relate-options\" sx-trigger=\"input delay:200ms, load\""
" sx-target=\"#rp-" kind "-results\" sx-swap=\"innerHTML\">"
"<input type=\"hidden\" name=\"kind\" value=\"" kind "\">"
"<input type=\"text\" name=\"q\" class=\"rp-filter\">"
"<ul id=\"rp-" kind "-results\" class=\"rp-results\">" candidates "</ul>"
"</form>"
"</div>")))
;; The "load more" sentinel, as host/blog--picker-more renders it. ;; The "load more" sentinel, as host/blog--picker-more renders it.
(define sentinel-html (define sentinel-html
(fn (slug kind offset) (fn (slug kind offset)
@@ -174,28 +198,38 @@
(loop (+ i 1))) (loop (+ i 1)))
acc))))) acc)))))
;; ── Phase 0: relate -> delete row ────────────────────────────────── ;; ── relating a candidate re-syncs the editor (adds to the current list)
;; Regression for "adding a related post doesn't add it to the list": the candidate
;; relate form re-renders the whole #rel-editor-KIND (outerHTML), so the related
;; post moves into the current-relations list and the fresh picker re-loads — both
;; lists stay in sync, in-page, no reload.
(defsuite (defsuite
"relate-picker:relate-delete" "relate-picker:relate-resyncs-editor"
(deftest (deftest
"submitting a candidate's relate form deletes just that row" "relating a candidate adds it to the current list and re-loads the picker"
(reset-fetch-mock!) (reset-fetch-mock!)
;; the AJAX relate returns an empty 200 (text/html); sx-swap=delete then (reset-reveal!)
;; removes the candidate's own <li> — this is the host's real response. ;; the picker's load shows one candidate (item-07) to click
(set! _mock-fetch-body (row-html "host" "related" "item-07" "Picker Item 07"))
(let (let
((root (mk-root (str "<ul class=\"rp-results\">" ((root (mk-root (str "<div id=\"content\">"
(row-html "host" "related" "item-07" "Picker Item 07") (editor-html "related" "" "")
"</ul>"))) "</div>")))
(results (dom-query ".rp-results")) (results (dom-query "#rp-related-results")))
(form (dom-query "form")))
(process-elements root) (process-elements root)
;; one candidate row before ;; load populated the candidate; current list empty
(assert-equal 1 (count-candidates results)) (assert-equal 1 (count-candidates results))
;; submit the relate form -> execute-request -> mock fetch -> delete swap (assert-nil (dom-query "a[href=\"/item-07/\"]"))
(fire-event! form "submit") ;; clicking it: the relate POST returns the re-rendered editor (item-07 now in
;; the fetch actually ran, and the row is gone ;; the current list), and the fresh picker re-loads OTHER candidates.
(assert-true (> _mock-fetch-calls 0)) (set! _mock-editor-body
(assert-equal 0 (count-candidates results)) (editor-html "related" (cur-row-html "host" "related" "item-07" "Picker Item 07") ""))
(set! _mock-fetch-body (rows-html "host" "related" 8 11)) ;; refreshed pool
(fire-event! (dom-query "#cand-related-item-07 form") "submit")
;; the related post is now in the current list (added, not just removed)...
(assert-true (not (nil? (dom-query "a[href=\"/item-07/\"]"))))
;; ...and the picker is NOT cleared — it re-loaded a fresh candidate page
(assert-equal 3 (count-candidates (dom-query "#rp-related-results")))
(clear-root! root)))) (clear-root! root))))
;; ── Phase 1: load / filter / paging / error-retry ─────────────────── ;; ── Phase 1: load / filter / paging / error-retry ───────────────────
@@ -308,41 +342,39 @@
(clear-root! root)))) (clear-root! root))))
;; ── regression: removing a relation must not clear the relate picker ─ ;; ── regression: removing a relation must not clear the relate picker ─
;; The remove button is an AJAX in-place delete (sx-post + sx-swap=delete on its own ;; The remove button re-renders the kind's editor (outerHTML #rel-editor-KIND): the
;; current-relation row). Submitting it deletes ONLY that row — the sibling picker's ;; row leaves the current list and the FRESH picker re-loads its candidates. (Bug:
;; candidate list is left intact, because #content is never re-rendered. (Bug: the ;; the old plain-boosted remove redirected and the re-rendered picker came back
;; old plain-boosted remove redirected and the re-rendered picker came back empty.) ;; empty — here the picker repopulates instead of clearing to 0.)
(defsuite (defsuite
"relate-picker:unrelate-keeps-picker" "relate-picker:unrelate-keeps-picker"
(deftest (deftest
"removing a current relation deletes just that row, leaving the picker intact" "removing a current relation re-syncs the editor and re-loads the picker"
(reset-fetch-mock!) (reset-fetch-mock!)
;; the AJAX unrelate returns an empty 200 (like the host); sx-swap=delete then (reset-reveal!)
;; removes the current-relation row in place. ;; start: Beta + Gamma are related; the picker (after load) shows nothing yet
(set! _mock-fetch-body "")
(let (let
((root (mk-root (str ((root (mk-root (str "<div id=\"content\">"
"<div id=\"cur-box\"><ul>" (editor-html "related"
(cur-row-html "host" "related" "beta" "Beta") (str (cur-row-html "host" "related" "beta" "Beta")
(cur-row-html "host" "related" "gamma" "Gamma") (cur-row-html "host" "related" "gamma" "Gamma"))
"</ul></div>" "")
"<div id=\"res-box\"><ul class=\"rp-results\">" "</div>"))))
(row-html "host" "related" "delta" "Picker Delta")
(row-html "host" "related" "epsilon" "Picker Epsilon")
"</ul></div>")))
(cur-box (dom-query "#cur-box"))
(res-box (dom-query "#res-box")))
(process-elements root) (process-elements root)
;; two current relations, two picker candidates to start (assert-equal 2 (len (dom-query-all (dom-query "#rel-editor-related") "ul.rp-current li")))
(assert-equal 2 (len (dom-query-all cur-box "li"))) ;; remove Beta: the unrelate POST returns the editor with only Gamma current,
(assert-equal 2 (len (dom-query-all res-box "li"))) ;; and the fresh picker re-loads candidates (Beta is available again).
;; remove Beta — submit its in-place remove form (set! _mock-editor-body
(fire-event! (dom-query (dom-query "#cur-related-beta") "form") "submit") (editor-html "related" (cur-row-html "host" "related" "gamma" "Gamma") ""))
;; just Beta's row is gone; Gamma remains (set! _mock-fetch-body (rows-html "host" "related" 0 4))
(assert-nil (dom-query "#cur-related-beta")) (fire-event! (dom-query "form") "submit") ;; Beta's remove form (first form)
(assert-true (not (nil? (dom-query "#cur-related-gamma")))) ;; Beta is gone from the current list; Gamma stays
(assert-equal 1 (len (dom-query-all cur-box "li"))) (assert-nil (dom-query "a[href=\"/beta/\"]"))
;; and the picker's candidate list is UNTOUCHED — the bug was it cleared to 0 (assert-true (not (nil? (dom-query "a[href=\"/gamma/\"]"))))
(assert-equal 2 (len (dom-query-all res-box "li"))) (assert-equal 1 (len (dom-query-all (dom-query "#rel-editor-related") "ul.rp-current li")))
;; and the picker is NOT cleared — it re-loaded a fresh candidate page
(assert-equal 4 (count-candidates (dom-query "#rp-related-results")))
(clear-root! root)))) (clear-root! root))))
;; ── Phase 3: the engine drives a non-browser target (the console) ─── ;; ── Phase 3: the engine drives a non-browser target (the console) ───