coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Stepper persistence: use def-store instead of broken cookies

Browse Source 
The home stepper's step-idx signal was not persisting across SX
navigation because set-cookie/freeze-to-sx wasn't working in the
WASM kernel. Replace with def-store which uses a global registry
that survives island re-hydration.

Also fix sx_http.exe build: add sx_http back to dune, inline scope
primitives (Sx_scope module was removed), add declarative form
stubs and render stubs, fix /sx/ home route mapping.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-29 18:27:08 +00:00
parent ef34122a25
commit 6134bd2ea5
4 changed files with 104 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
hosts/ocaml/bin/dune
View File

@@ -1,5 +1,5 @@
(executables
(names run_tests debug_set sx_server integration_tests)
(names run_tests debug_set sx_server sx_http integration_tests)
(libraries sx unix))
(executable

58
hosts/ocaml/bin/sx_http.ml
View File

@@ -74,7 +74,61 @@ let setup_io_stubs env =
let make_http_env () =
let env = make_env () in
Sx_render.setup_render_env env;
Sx_scope.setup_scope_env env;
(* Scope primitives — inline since Sx_scope was merged *)
let _scope_stacks : (string, Sx_types.value list) Hashtbl.t = Hashtbl.create 8 in
let bind name fn = ignore (Sx_types.env_bind env name (Sx_types.NativeFn (name, fn))) in
bind "scope-push!" (fun args -> match args with
| [String name; value] -> let s = try Hashtbl.find _scope_stacks name with Not_found -> [] in Hashtbl.replace _scope_stacks name (value :: s); Nil
| [String name] -> let s = try Hashtbl.find _scope_stacks name with Not_found -> [] in Hashtbl.replace _scope_stacks name (Nil :: s); Nil
| _ -> Nil);
bind "scope-pop!" (fun args -> match args with
| [String name] -> (match (try Hashtbl.find _scope_stacks name with Not_found -> []) with _ :: rest -> Hashtbl.replace _scope_stacks name rest | [] -> ()); Nil
| _ -> Nil);
bind "scope-peek" (fun args -> match args with
| [String name] -> (match (try Hashtbl.find _scope_stacks name with Not_found -> []) with v :: _ -> v | [] -> Nil)
| _ -> Nil);
bind "scope-emit!" (fun args -> match args with
| [String name; value] ->
let key = name ^ ":emitted" in
let s = try Hashtbl.find _scope_stacks key with Not_found -> [] in
Hashtbl.replace _scope_stacks key (value :: s); Nil
| _ -> Nil);
bind "scope-emitted" (fun args -> match args with
| [String name] ->
let key = name ^ ":emitted" in
let items = try Hashtbl.find _scope_stacks key with Not_found -> [] in
Hashtbl.replace _scope_stacks key []; List (List.rev items)
| _ -> List []);
bind "collect!" (fun args -> match args with
| [String name; value] ->
let key = name ^ ":collected" in
let s = try Hashtbl.find _scope_stacks key with Not_found -> [] in
Hashtbl.replace _scope_stacks key (value :: s); Nil
| _ -> Nil);
bind "collected" (fun args -> match args with
| [String name] ->
let key = name ^ ":collected" in
let items = try Hashtbl.find _scope_stacks key with Not_found -> [] in
Hashtbl.replace _scope_stacks key []; List (List.rev items)
| _ -> List []);
(* Declarative form stubs — no-ops at runtime *)
bind "define-module" (fun _args -> Nil);
bind "define-primitive" (fun _args -> Nil);
bind "deftype" (fun _args -> Nil);
bind "defeffect" (fun _args -> Nil);
bind "deftest" (fun _args -> Nil);
bind "defstyle" (fun _args -> Nil);
bind "defhandler" (fun _args -> Nil);
bind "defpage" (fun _args -> Nil);
bind "defquery" (fun _args -> Nil);
bind "defaction" (fun _args -> Nil);
bind "defrelation" (fun _args -> Nil);
(* Render stubs *)
bind "set-render-active!" (fun _args -> Nil);
bind "render-active?" (fun _args -> Bool true);
bind "trampoline" (fun args -> match args with
| [Thunk (expr, e)] -> Sx_ref.eval_expr expr (Env e)
| [v] -> v | _ -> Nil);
(* Setup all the standard primitives *)
(* Evaluator bridge — needed for aser, macro expansion *)
ignore (env_bind env "eval-expr" (NativeFn ("eval-expr", fun args ->
@@ -236,7 +290,7 @@ let sx_render_to_html expr env =
let render_page env statics path =
let t0 = Unix.gettimeofday () in
(* Build the page AST: evaluate the URL path as an SX expression *)
let path_expr = if path = "/" || path = "" then "home"
let path_expr = if path = "/" || path = "" || path = "/sx/" || path = "/sx" then "home"
else begin
(* /sx/(geography.(reactive)) → (geography (reactive)) *)
let p = if String.length path > 4 && String.sub path 0 4 = "/sx/" then

28
sx/sx/home-stepper.sx
View File

@@ -2,9 +2,11 @@
~home/stepper
()
(let
((source "(div (~cssx/tw :tokens \"text-center\")\n (h1 (~cssx/tw :tokens \"text-3xl font-bold mb-2\")\n (span (~cssx/tw :tokens \"text-rose-500\") \"the \")\n (span (~cssx/tw :tokens \"text-amber-500\") \"joy \")\n (span (~cssx/tw :tokens \"text-emerald-500\") \"of \")\n (span (~cssx/tw :tokens \"text-violet-600 text-4xl\") \"sx\")))")
((source (first (sx-parse "(div (~cssx/tw :tokens \"text-center\")\n (h1 (~cssx/tw :tokens \"text-3xl font-bold mb-2\")\n (span (~cssx/tw :tokens \"text-rose-500\") \"the \")\n (span (~cssx/tw :tokens \"text-amber-500\") \"joy \")\n (span (~cssx/tw :tokens \"text-emerald-500\") \"of \")\n (span (~cssx/tw :tokens \"text-violet-600 text-4xl\") \"sx\")))")))
(store
(if (client?) (def-store "home-stepper" (fn () {:step-idx (signal 9)})) nil))
(steps (signal (list)))
(step-idx (signal 9))
(step-idx (if store (get store "step-idx") (signal 9)))
(dom-stack-sig (signal (list)))
(code-tokens (signal (list))))
(letrec
@@ -264,17 +266,7 @@
((target (- (deref step-idx) 1)))
(rebuild-preview target)
(reset! step-idx target)
(update-code-highlight)
(set-cookie "sx-home-stepper" (freeze-to-sx "home-stepper")))))))
(freeze-scope "home-stepper" (fn () (freeze-signal "step" step-idx)))
(let
((saved (get-cookie "sx-home-stepper")))
(when
saved
(thaw-from-sx saved)
(when
(or (< (deref step-idx) 0) (> (deref step-idx) 16))
(reset! step-idx 9))))
(update-code-highlight))))))
(let
((parsed (sx-parse source)))
(when
@@ -320,10 +312,7 @@
(div
:class "flex items-center justify-center gap-2 md:gap-3"
(button
:on-click (fn
(e)
(do-back)
(set-cookie "sx-home-stepper" (freeze-to-sx "home-stepper")))
:on-click (fn (e) (do-back))
:class (str
"px-2 py-1 rounded text-3xl "
(if
@@ -337,10 +326,7 @@
" / "
(len (deref steps)))
(button
:on-click (fn
(e)
(do-step)
(set-cookie "sx-home-stepper" (freeze-to-sx "home-stepper")))
:on-click (fn (e) (do-step))
:class (str
"px-2 py-1 rounded text-3xl "
(if

40
tests/playwright/navigation.spec.js
View File

@@ -125,6 +125,46 @@ test.describe('Page Navigation', () => {
expect(after).toContain('geography');
});
test('stepper persists index across navigation', async ({ page }) => {
await page.goto(BASE_URL + '/sx/', { waitUntil: 'networkidle' });
await page.waitForTimeout(3000);
// Get the initial stepper index
const getIndex = () => page.evaluate(() => {
const el = document.querySelector('[data-sx-island="home/stepper"]');
const m = el && el.textContent.match(/(\d+)\s*\/\s*\d+/);
return m ? parseInt(m[1]) : null;
});
const initial = await getIndex();
expect(initial).not.toBeNull();
// Advance the stepper
await page.evaluate(() => {
const btns = document.querySelectorAll('[data-sx-island="home/stepper"] button');
if (btns.length >= 2) btns[1].click(); // next button
});
await page.waitForTimeout(500);
const advanced = await getIndex();
expect(advanced).toBe(initial + 1);
// Navigate away
await page.click('a[sx-get*="(geography)"]');
await page.waitForTimeout(2000);
// Navigate back home
await page.evaluate(() => {
const link = document.querySelector('a[sx-get*="/sx/"]');
if (link) link.click();
});
await page.waitForTimeout(3000);
// Stepper should still show the advanced index
const afterNav = await getIndex();
expect(afterNav).toBe(advanced);
});
test('header island renders with SSR', async ({ page }) => {
await page.goto(BASE_URL + '/sx/(geography)', { waitUntil: 'networkidle' });