diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index 183b26d3..7c197d99 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/hosts/ocaml/bin/sx_server.ml @@ -32,6 +32,14 @@ let () = ignore (Sx_vm_extensions.id_of_name "") which we swallow so a re-entered server process doesn't die. *) let () = try Erlang_ext.register () with Failure _ -> () +(* Ignore SIGPIPE: a client that closes its connection mid-response (a browser + aborting an in-flight fetch — the SX engine cancels superseded requests on a + debounced filter or a fast nav) must NOT kill the server. SIGPIPE's default + action terminates the process before any exception is raised; ignoring it + turns the failed write into a catchable Sys_error (EPIPE), which the + per-connection handler already swallows, dropping just that one connection. *) +let () = try Sys.set_signal Sys.sigpipe Sys.Signal_ignore with _ -> () + (* ====================================================================== *) (* Font measurement via otfm — reads OpenType/TrueType font tables *) (* ====================================================================== *) diff --git a/lib/dream/form.sx b/lib/dream/form.sx index 1593b698..1862bbe5 100644 --- a/lib/dream/form.sx +++ b/lib/dream/form.sx @@ -58,6 +58,43 @@ ((s2 (replace s "+" " "))) (dr/url-decode-loop s2 0 (string-length s2) "")))) +;; ── percent encoding (symmetric with dr/url-decode) ──────────────── +;; RFC3986 unreserved set passes through; everything else is %XX (uppercase +;; hex). Space becomes %20 (not +), so the result is safe in a query value. +(define dr/hex-chars "0123456789ABCDEF") +(define + dr/url-encode-char + (fn + (c) + (let + ((n (char-code c))) + (if + (or + (and (>= n 48) (<= n 57)) ;; 0-9 + (and (>= n 65) (<= n 90)) ;; A-Z + (and (>= n 97) (<= n 122)) ;; a-z + (= c "-") (= c "_") (= c ".") (= c "~")) + c + (str "%" + (char-at dr/hex-chars (quotient n 16)) + (char-at dr/hex-chars (mod n 16))))))) + +(define + dr/url-encode-loop + (fn + (s i n acc) + (if + (>= i n) + acc + (dr/url-encode-loop s (+ i 1) n + (str acc (dr/url-encode-char (char-at s i))))))) + +(define + dr/url-encode + (fn + (s) + (dr/url-encode-loop (or s "") 0 (string-length (or s "")) ""))) + ;; ── substring splitter (split primitive is char-class based) ─────── (define dr/split-on diff --git a/lib/host/blog.sx b/lib/host/blog.sx index ff5de42b..486fd091 100644 --- a/lib/host/blog.sx +++ b/lib/host/blog.sx @@ -363,7 +363,11 @@ (fn (slug p kind) (quasiquote (li :style "border-bottom:1px solid #eee" - (form :method "post" :style "margin:0" + ;; sx-disable: this relate form is a plain POST -> 303 -> full reload (the + ;; engine swaps the picker rows in, which would otherwise boost this form; + ;; a boosted POST+redirect into #content swaps unreliably). A relate is a + ;; deliberate action, so a clean reload that re-renders the editor is right. + (form :method "post" :style "margin:0" :sx-disable "true" :action (unquote (str "/" slug "/relate")) (input :type "hidden" :name "other" :value (unquote (get p :slug))) (input :type "hidden" :name "kind" :value (unquote kind)) @@ -371,9 +375,29 @@ :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
  • 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 //relate-options?kind=&q=&offset= — one page of candidate rows for a -;; kind as an HTML fragment (the
  • s the picker script appends). Public read; the -;; relate action stays guarded. +;; 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")) @@ -384,20 +408,12 @@ (offset (host/query-int req "offset" 0))) (let ((page (take (drop (host/blog--relate-candidates slug q kind) offset) host/blog--picker-limit))) - (dream-html - (join "" (map (fn (p) (render-page (host/blog--picker-item slug p kind))) page))))))) + (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))))))) -;; GET /relate-picker.js — progressive-enhancement glue. MULTI-INSTANCE: wires -;; every .relate-picker box on the page (a Related picker + a Tags picker can -;; coexist), reading data-slug + data-kind from each. Debounced live filter + -;; scroll-to-load-more against //relate-options. The host serves static HTML -;; (no SX hydration), so the interactive layer is this small cached script. -(define host/blog-picker-js-src - "(function(){function wire(box){var f=box.querySelector('.rp-filter');if(!f)return;var r=box.querySelector('.rp-results');var slug=box.getAttribute('data-slug'),kind=box.getAttribute('data-kind')||'related',off=0,q='',busy=false,done=false,pending=false,t;function load(reset){if(busy){if(reset)pending=true;return;}if(!reset&&done)return;busy=true;if(reset){off=0;done=false;}fetch('/'+slug+'/relate-options?kind='+encodeURIComponent(kind)+'&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;if(pending){pending=false;load(true);}}).catch(function(){busy=false;if(pending){pending=false;load(true);}});}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);}var boxes=document.querySelectorAll('.relate-picker');for(var i=0;i 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")) (body @@ -536,9 +558,9 @@ (else ""))))) ;; Kind-aware relation editor for the edit page: current links (each with a -;; kind-scoped remove), plus a filterable picker (a .relate-picker box the shared -;; /relate-picker.js wires by data-kind). The picker's candidates come from the -;; kind's registry :candidates ("all" / tags / types). One editor per kind. +;; 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 @@ -561,11 +583,25 @@ (button :type "submit" "remove"))))) current)) (quote (p :style "opacity:0.7" "None yet.")))) - (div :class "relate-picker" :data-slug (unquote slug) :data-kind (unquote kind) - (input :type "text" :class "rp-filter" :placeholder "filter…" :autocomplete "off" + ;; Declarative SX-htmx picker (no client JS). The form GETs relate-options + ;; serialising its inputs (kind + the filter q) into the query: on initial + ;; "load" and on a debounced "input" it innerHTML-swaps the results ul. + ;; Paging is driven by the "load more" sentinel each page carries. The + ;; SX engine re-binds these triggers on swapped-in content, so the picker + ;; works whether the edit page is a full load or a boosted SPA nav. + (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" + ;; a failed initial/filter fetch retries with backoff (1s→30s) + :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") - (ul :class "rp-results" - :style "list-style:none;padding:0;margin:0.5em 0;max-height:240px;overflow:auto;border:1px solid #ddd"))))))) + (ul :id (unquote (str "rp-" kind "-results")) :class "rp-results" + :style "list-style:none;padding:0;margin:0.5em 0;border:1px solid #ddd"))))))) ;; "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). @@ -889,8 +925,6 @@ (div :style "margin-top:2em;border-top:1px solid #ccc;padding-top:1em" (unquote tag-toggle)) (unquote relation-editors) - ;; one shared picker script wires every .relate-picker box - (raw! "") (p :style "margin-top:1.5em" (a :href (unquote (str "/" slug "/")) "view post") " · " @@ -935,7 +969,6 @@ (dream-get "/posts" host/blog-index) (dream-get "/new" host/blog-new-form) (dream-get "/tags" host/blog-tags-index) - (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))) diff --git a/lib/host/conformance.sh b/lib/host/conformance.sh index 422cf9eb..8a80d03d 100755 --- a/lib/host/conformance.sh +++ b/lib/host/conformance.sh @@ -76,6 +76,7 @@ MODULES=( "lib/host/auth.sx" "lib/host/sxtp.sx" "lib/host/router.sx" + "lib/host/static.sx" "lib/host/feed.sx" "lib/host/relations.sx" "lib/host/blog.sx" diff --git a/lib/host/playwright/relate-picker.spec.js b/lib/host/playwright/relate-picker.spec.js index d1decede..a0fcdade 100644 --- a/lib/host/playwright/relate-picker.spec.js +++ b/lib/host/playwright/relate-picker.spec.js @@ -1,20 +1,32 @@ // Browser check for the relate picker (lib/host/blog.sx). Runs against an // ephemeral host server seeded with a host post + 25 candidates by // run-picker-check.sh, which copies this spec into the Playwright env and sets -// SX_TEST_URL. Exercises the login redirect, the JS-driven candidate load, -// debounced filter, infinite scroll, and click-to-relate. +// SX_TEST_URL. The picker is a DECLARATIVE SX-htmx form (no client JS): the form +// GETs //relate-options on "load" and on a debounced "input", swapping the +// results
      ; a full page carries a "load more" sentinel that pages on reveal. +// Exercises the login redirect, the initial populate, debounced filter, infinite +// scroll, click-to-relate, AND populate after a boosted SPA nav (the case the old +// inline