From fe2da2d3589c73e3204e2fa0a98b2ea956b6d7b2 Mon Sep 17 00:00:00 2001 From: giles Date: Mon, 29 Jun 2026 17:50:49 +0000 Subject: [PATCH] =?UTF-8?q?host/tests:=20Phase=201=20=E2=80=94=20picker=20?= =?UTF-8?q?load/filter/paging/error-retry=20as=20SX=20engine=20tests?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Port the rest of the relate-picker's interactive behaviours from Playwright into the SX harness, driving the real engine against the mock DOM: - load: the form's "load" trigger populates the results on first render - filter: a debounced "input" re-fetches and narrows the candidates - paging: revealing the load-more sentinel pages in the next page (outerHTML swap replaces the sentinel) - error-retry: a dropped fetch marks .sx-error, and the next request clears it Models two browser natives the OCaml runner lacks: observe-intersection (a recording stub the test fires to simulate the sentinel scrolling into view) and the synchronous-timer retry (stripped in the error test — backoff timing is a test-engine.sx concern; here we assert the visible state). Mock-DOM completeness (run_tests.ml): firstChild/lastChild on elements, so children-to-fragment can drain a parsed fragment into an innerHTML/outerHTML swap target. (Also repairs one pre-existing web test that needed firstChild.) Co-Authored-By: Claude Opus 4.8 --- hosts/ocaml/bin/run_tests.ml | 7 +- web/tests/test-relate-picker.sx | 213 +++++++++++++++++++++++++++----- 2 files changed, 189 insertions(+), 31 deletions(-) diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml index 8a4e1d44..1b5658ac 100644 --- a/hosts/ocaml/bin/run_tests.ml +++ b/hosts/ocaml/bin/run_tests.ml @@ -2812,10 +2812,13 @@ let run_spec_tests env test_files = | "insertAdjacentHTML" | "prepend" | "showModal" | "show" | "close" | "getBoundingClientRect" | "getAnimations" | "scrollIntoView" | "scrollTo" | "scroll" | "reset" -> Bool true - | "firstElementChild" -> + | "firstElementChild" | "firstChild" -> + (* the mock treats element children and child nodes alike, so + firstChild == firstElementChild — children-to-fragment walks + firstChild to drain a parsed fragment into a swap target. *) let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in (match kids with c :: _ -> c | [] -> Nil) - | "lastElementChild" -> + | "lastElementChild" | "lastChild" -> let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in (match List.rev kids with c :: _ -> c | [] -> Nil) | "nextElementSibling" | "nextSibling" -> diff --git a/web/tests/test-relate-picker.sx b/web/tests/test-relate-picker.sx index e275353c..52dcef82 100644 --- a/web/tests/test-relate-picker.sx +++ b/web/tests/test-relate-picker.sx @@ -10,9 +10,10 @@ ;; ;; Pattern (mirrors test-swap-integration.sx's mock-response approach): ;; 1. build a mock DOM by setting innerHTML on a container attached to the body -;; 2. (process-elements root) binds the engine's triggers (form submit etc.) +;; 2. (process-elements root) binds the engine's triggers (load / input / submit) ;; 3. override `fetch-request` to invoke the success/error callback with a -;; mocked response (status, content-type, body) +;; mocked response (status, content-type, body) — relate-options returns +;; HTML rows, so the body is HTML and the engine swaps via DOMParser ;; 4. fire the trigger (dispatch a DOM event) and assert the resulting DOM ;; ── mock fetch ────────────────────────────────────────────────────── @@ -47,18 +48,30 @@ ;; ── harness platform shims ────────────────────────────────────────── ;; Reactive hydration + island disposal live in web/boot.sx (the browser boot ;; module, not loaded by the test runner — it pulls the signals/adapter-dom boot -;; chain). The picker is plain SX-htmx with no islands or reactive attrs, so every -;; one of these is a no-op here. Defined at top level so orchestration's swap path +;; chain). The picker is plain SX-htmx with no islands or reactive attrs, so each +;; of these is a no-op here. Defined at top level so orchestration's swap path ;; (post-swap -> sx-hydrate -> sx-hydrate-elements, dispose-islands-in) resolves ;; them by late binding through the global env — the same mechanism that lets the ;; fetch-request override above take effect. With these in place post-swap runs to ;; completion, including its final (process-elements root) that re-binds triggers -;; on swapped-in content — which the paging tests below depend on. +;; on swapped-in content — which the paging test below depends on. (define dispose-islands-in (fn (root) nil)) (define sx-hydrate-elements (fn (root) nil)) (define sx-hydrate-islands (fn (root) nil)) (define run-post-render-hooks (fn () nil)) +;; observe-intersection is a platform NATIVE (registered by the browser's +;; sx-platform.js, absent in the OCaml test runner). The picker's "load more" +;; sentinel binds its `revealed` trigger through it. Model it as a recording stub: +;; binding the sentinel registers its reveal callback; the test fires it explicitly +;; to simulate the sentinel scrolling into view. Without this, process-elements +;; would throw on the sentinel's trigger and the paged-in content would never bind. +(define _last-reveal nil) +(define observe-intersection + (fn (el callback once delay) (set! _last-reveal callback))) +(define reset-reveal! (fn () (set! _last-reveal nil))) +(define fire-reveal! (fn () (when _last-reveal (_last-reveal)))) + ;; ── mock DOM helpers ──────────────────────────────────────────────── ;; Build a detached-then-attached subtree from an HTML string and return the ;; container. Attaching to (dom-body) is required because resolve-target uses @@ -76,33 +89,73 @@ (fn (container) (when container (dom-remove-child (dom-body) container)))) -;; Fire a (non-bubbling) DOM event of `type` on `el`, as the browser would. +;; Fire a (non-bubbling) DOM event of `type` on `el`, as the browser would. The +;; engine's triggers listen directly on the element carrying the verb (the form), +;; so the event need not bubble. (define fire-event! (fn (el type) (host-call el "dispatchEvent" (host-new "Event" type)))) -;; Count candidate rows (the engine's own dom-query-all, the same call the -;; picker uses) — asserts through the platform DOM API, not a private shape. -(define count-rows - (fn (container) (len (dom-query-all container "li")))) +;; Candidate-row / sentinel counts via the engine's own dom-query-all — asserts +;; through the platform DOM API, not a private shape. Sentinel rows carry .rp-more; +;; candidate rows are the rest (mirrors the spec's `li:not(.rp-more)`). +(define count-li (fn (c) (len (dom-query-all c "li")))) +(define count-more (fn (c) (len (dom-query-all c "li.rp-more")))) +(define count-candidates (fn (c) (- (count-li c) (count-more c)))) -;; The picker's candidate row, exactly as host/blog--picker-item renders it: -;; an
  • wrapping a relate
    . -(define picker-row-html - (fn (slug kind title) +;; ── markup builders (the expanded ~relate-picker, server-rendered) ── +;; The picker form, exactly as ~relate-picker (lib/host/sx/relate-picker.sx) +;; expands: sx-get the candidate list, innerHTML-swap into its results
      on +;; "load" and on a debounced "input". +(define picker-form-html + (fn (slug kind) (str - "
        " - "
      • " - "" - "" - "" - "" - "
        • " - "" - "
      "))) + "
      " + "" + "" + "
        " + "
        "))) + +;; One candidate row, as host/blog--picker-item renders it. +(define row-html + (fn (slug kind cand title) + (str + "
      • " + "
        " + "" + "" + "" + "
        " + "
        • "))) + +;; The "load more" sentinel, as host/blog--picker-more renders it. +(define sentinel-html + (fn (slug kind offset) + (str + "
      • Loading more…
        • "))) + +;; A page of N candidate rows "cand-i" / "Item i" for i in [lo, hi). +(define rows-html + (fn (slug kind lo hi) + (let ((acc "")) + (let loop ((i lo)) + (if (< i hi) + (do + (set! acc (str acc (row-html slug kind (str "item-" i) (str "Picker Item " i)))) + (loop (+ i 1))) + acc))))) ;; ── Phase 0: relate -> delete row ─────────────────────────────────── (defsuite @@ -113,15 +166,117 @@ ;; the AJAX relate returns an empty 200 (text/html); sx-swap=delete then ;; removes the candidate's own
      • — this is the host's real response. (let - ((root (mk-root (picker-row-html "item-07" "related" "Picker Item 07"))) + ((root (mk-root (str "
          " + (row-html "host" "related" "item-07" "Picker Item 07") + "
        "))) (results (dom-query ".rp-results")) (form (dom-query "form"))) (process-elements root) ;; one candidate row before - (assert-equal 1 (count-rows results)) + (assert-equal 1 (count-candidates results)) ;; submit the relate form -> execute-request -> mock fetch -> delete swap (fire-event! form "submit") ;; the fetch actually ran, and the row is gone (assert-true (> _mock-fetch-calls 0)) - (assert-equal 0 (count-rows results)) + (assert-equal 0 (count-candidates results)) + (clear-root! root)))) + +;; ── Phase 1: load / filter / paging / error-retry ─────────────────── +(defsuite + "relate-picker:load" + (deftest + "the load trigger populates the results on first render" + (reset-fetch-mock!) + (reset-reveal!) + ;; one full page of candidates (no sentinel) returned for the load fetch + (set! _mock-fetch-body (rows-html "host" "related" 0 5)) + (let + ((root (mk-root (picker-form-html "host" "related"))) + (results (dom-query "#rp-related-results"))) + ;; results empty before binding + (assert-equal 0 (count-candidates results)) + ;; process-elements binds the "load" trigger; the harness fires its + ;; set-timeout synchronously, so the populate fetch runs here + (process-elements root) + (assert-true (> _mock-fetch-calls 0)) + (assert-equal 5 (count-candidates results)) + (clear-root! root)))) + +(defsuite + "relate-picker:filter" + (deftest + "typing in the filter re-fetches and narrows the candidates" + (reset-fetch-mock!) + (reset-reveal!) + ;; load shows 5 candidates... + (set! _mock-fetch-body (rows-html "host" "related" 0 5)) + (let + ((root (mk-root (picker-form-html "host" "related"))) + (results (dom-query "#rp-related-results")) + (form (dom-query ".relate-picker")) + (filter (dom-query ".rp-filter"))) + (process-elements root) + (assert-equal 5 (count-candidates results)) + ;; ...the filter narrows to a single match + (set! _mock-fetch-body (row-html "host" "related" "item-13" "Picker Item 13")) + (dom-set-attr filter "value" "Item 13") + ;; debounced "input" trigger (delay fires synchronously in the harness) + (fire-event! form "input") + (assert-equal 1 (count-candidates results)) + (clear-root! root)))) + +(defsuite + "relate-picker:paging" + (deftest + "revealing the load-more sentinel pages in the next page and replaces it" + (reset-fetch-mock!) + (reset-reveal!) + ;; page 1: a full page of rows FOLLOWED BY the load-more sentinel + (set! _mock-fetch-body (str (rows-html "host" "related" 0 20) + (sentinel-html "host" "related" 20))) + (let + ((root (mk-root (picker-form-html "host" "related"))) + (results (dom-query "#rp-related-results"))) + (process-elements root) + ;; first page populated, sentinel present + (assert-equal 20 (count-candidates results)) + (assert-equal 1 (count-more results)) + ;; page 2: the last page — more rows, NO sentinel + (set! _mock-fetch-body (rows-html "host" "related" 20 25)) + ;; the sentinel scrolling into view fires its `revealed` trigger + (fire-reveal!) + ;; the new rows are appended and the sentinel (swapped outerHTML) is gone + (assert-equal 25 (count-candidates results)) + (assert-equal 0 (count-more results)) + (clear-root! root)))) + +(defsuite + "relate-picker:error-retry" + (deftest + "a dropped fetch shows .sx-error, and the next success clears it" + (reset-fetch-mock!) + (reset-reveal!) + ;; the candidate fetch drops on load + (set! _mock-fetch-fail true) + (let + ((root (mk-root (picker-form-html "host" "related"))) + (results (dom-query "#rp-related-results")) + (form (dom-query ".relate-picker"))) + ;; sx-retry self-heals via exponential backoff on set-timeout — which fires + ;; SYNCHRONOUSLY in the harness, so a retry against a still-failing mock would + ;; recurse forever. Strip it: we assert the VISIBLE error state and that the + ;; next *request* (the user retyping) clears it. The backoff math itself is + ;; covered by test-engine.sx (parse-retry-spec / next-retry-ms). + (dom-remove-attr form "sx-retry") + (process-elements root) + ;; visible failure state: .sx-error lands on the picker form + (assert-true (dom-has-class? form "sx-error")) + (assert-equal 0 (count-candidates results)) + ;; recovery: the endpoint works again, the next input retries and the error + ;; clears as the results populate + (set! _mock-fetch-fail false) + (set! _mock-fetch-body (rows-html "host" "related" 0 3)) + (fire-event! form "input") + (assert-false (dom-has-class? form "sx-error")) + (assert-equal 3 (count-candidates results)) (clear-root! root))))