;; SX-native engine tests for the host's relate picker (lib/host/blog.sx). ;; ;; These drive the REAL hypermedia engine (web/engine.sx + web/orchestration.sx) ;; against the OCaml test harness's in-memory mock DOM — NO browser. They are the ;; SX-native replacement for lib/host/playwright/relate-picker.spec.js: the same ;; populate / filter / paging / relate-delete / error-retry behaviours, asserted ;; with zero Chromium. The engine only ever talks to a *platform* (fetch, DOM ops, ;; timers) that is injected; the harness supplies a mock platform, so the engine's ;; fetch -> swap -> DOM-mutation loop is exercised end to end in pure SX. ;; ;; 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 (load / input / submit) ;; 3. override `fetch-request` to invoke the success/error callback with a ;; 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 ────────────────────────────────────────────────────── ;; The engine's do-fetch calls (fetch-request config success-fn error-fn) with ;; success-fn signature (resp-ok status get-header text). We override it to feed a ;; canned response synchronously — the swap path then runs exactly as in a browser. (define _mock-fetch-calls 0) (define _mock-fetch-ok true) (define _mock-fetch-status 200) (define _mock-fetch-ct "text/html; charset=utf-8") (define _mock-fetch-body "") (define _mock-fetch-fail false) (define reset-fetch-mock! (fn () (set! _mock-fetch-calls 0) (set! _mock-fetch-ok true) (set! _mock-fetch-status 200) (set! _mock-fetch-ct "text/html; charset=utf-8") (set! _mock-fetch-body "") (set! _mock-fetch-fail false))) (define fetch-request (fn (config success-fn error-fn) (set! _mock-fetch-calls (+ _mock-fetch-calls 1)) (if _mock-fetch-fail (error-fn "network error") (success-fn _mock-fetch-ok _mock-fetch-status (fn (name) (if (= name "content-type") _mock-fetch-ct nil)) _mock-fetch-body)))) ;; ── 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 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 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 ;; (dom-query "#id") which queries the document. (define mk-root (fn (html) (let ((container (dom-create-element "div" nil))) (dom-set-attr container "id" "test-root") (dom-append (dom-body) container) (dom-set-inner-html container html) container))) ;; Remove the test root from the body so tests don't leak DOM into each other. (define clear-root! (fn (container) (when container (dom-remove-child (dom-body) container)))) ;; 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)))) ;; 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)))) ;; ── 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