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

Stepper cookie persistence: SSR + client-side save/restore

Browse Source 
- Parse Cookie header in OCaml HTTP server for get-cookie primitive
- Stepper saves step-idx to cookie via host-set! FFI on click
- Stepper restores from cookie: get-cookie on server, host-get FFI on client
- Cache key includes stepper cookie value to avoid stale SSR
- registerNative: also update Sx_primitives table for CALL_PRIM dispatch

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-02 10:28:22 +00:00
parent 7651260fc7
commit e44a689783
3 changed files with 55 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
hosts/ocaml/bin/sx_server.ml
View File

@@ -1761,6 +1761,9 @@ let http_inject_shell_statics env static_dir sx_sxc =
let templates_dir = project_dir ^ "/shared/sx/templates" in
let client_libs = [
templates_dir ^ "/cssx.sx";
templates_dir ^ "/tw-layout.sx";
templates_dir ^ "/tw-type.sx";
templates_dir ^ "/tw.sx";
] in
List.iter (fun path ->
if Sys.file_exists path then begin
@@ -2593,6 +2596,21 @@ let http_mode port =
_req_headers := parse_http_headers data;
_req_body := (if method_ = "POST" || method_ = "PUT" || method_ = "PATCH"
then extract_body data else "");
(* Parse Cookie header into request_cookies for get-cookie primitive *)
Hashtbl.clear _request_cookies;
(match List.assoc_opt "cookie"
(List.map (fun (k,v) -> (String.lowercase_ascii k, v)) !_req_headers) with
| Some cookie_str ->
List.iter (fun pair ->
let trimmed = String.trim pair in
(match String.index_opt trimmed '=' with
| Some i ->
let k = String.sub trimmed 0 i in
let v = String.sub trimmed (i+1) (String.length trimmed - i - 1) in
Hashtbl.replace _request_cookies k v
| None -> ())
) (String.split_on_char ';' cookie_str)
| None -> ());
if path = "/" then begin
write_response fd (http_redirect "/sx/"); true
end else
@@ -2736,7 +2754,10 @@ let http_mode port =
in
write_response fd response; true
end else if is_sx then begin
let cache_key = if is_ajax then "ajax:" ^ path else path in
let has_stepper_cookie = Hashtbl.mem _request_cookies "sx-home-stepper" in
let cache_key = if is_ajax then "ajax:" ^ path
else if has_stepper_cookie then path ^ ":step=" ^ (try Hashtbl.find _request_cookies "sx-home-stepper" with Not_found -> "")
else path in
match Hashtbl.find_opt response_cache cache_key with
| Some cached -> write_response fd cached; true
| None ->

1
hosts/ocaml/browser/sx_browser.ml
View File

@@ -401,6 +401,7 @@ let api_register_native name_js callback_js =
js_to_value (Js.Unsafe.fun_call callback_js [| Js.Unsafe.inject (Js.array js_args) |])
in
let v = NativeFn (name, native_fn) in
Sx_primitives.register name native_fn;
ignore (env_bind global_env name v);
Hashtbl.replace _vm_globals name v;
Js.Unsafe.inject Js.null

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

@@ -2,9 +2,10 @@
~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 "(div (~tw :tokens \"text-center\")\n (h1 (~tw :tokens \"text-3xl font-bold mb-2\")\n (span (~tw :tokens \"text-rose-500\") \"the \")\n (span (~tw :tokens \"text-amber-500\") \"joy \")\n (span (~tw :tokens \"text-emerald-500\") \"of \")\n (span (~tw :tokens \"text-violet-600 text-4xl\") \"sx\")))")
(steps (signal (list)))
(store (if (client?) (def-store "home-stepper" (fn () {:step-idx (signal 9)})) nil))
(store
(if (client?) (def-store "home-stepper" (fn () {:step-idx (signal 9)})) nil))
(step-idx (if store (get store "step-idx") (signal 9)))
(dom-stack-sig (signal (list)))
(code-tokens (signal (list))))
@@ -204,7 +205,7 @@
(= (keyword-name (nth sp 1)) "tokens")
(string? (nth sp 2)))
(let
((result (trampoline (~cssx/tw :tokens (nth sp 2)))))
((result (trampoline (~tw :tokens (nth sp 2)))))
(when
(spread? result)
(let
@@ -239,7 +240,14 @@
(= step-type "expr")
nil))
(swap! step-idx inc)
(update-code-highlight))))
(update-code-highlight)
(host-set!
(dom-document)
"cookie"
(str
"sx-home-stepper="
(deref step-idx)
";path=/;max-age=31536000;SameSite=Lax")))))
(rebuild-preview
(fn
(target)
@@ -266,16 +274,22 @@
(rebuild-preview target)
(reset! step-idx target)
(update-code-highlight)
)))))
(host-set!
(dom-document)
"cookie"
(str
"sx-home-stepper="
target
";path=/;max-age=31536000;SameSite=Lax")))))))
(let
((saved (get-cookie "sx-home-stepper")))
((saved (if (client?) (let ((raw (host-get (dom-document) "cookie")) (prefix "sx-home-stepper=")) (when (and (string? raw) (contains? raw prefix)) (let ((start (+ (index-of raw prefix) (len prefix)))) (let ((rest (slice raw start)) (end-pos (index-of rest ";"))) (if (> end-pos -1) (slice rest 0 end-pos) rest))))) (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))))
(string? saved)
(let
((n (parse-number saved)))
(when
(and (number? n) (>= n 0) (<= n 16))
(reset! step-idx n)))))
(let
((parsed (sx-parse source)))
(when
@@ -292,10 +306,10 @@
(let
((_eff (effect (fn () (schedule-idle (fn () (build-code-dom) (rebuild-preview (deref step-idx)) (update-code-highlight) (run-post-render-hooks)))))))
(div
:class "space-y-4"
(~tw :tokens "space-y-4 text-center")
(div
:data-code-view true
(~cssx/tw
(~tw
:tokens "font-mono bg-stone-50 rounded p-2 overflow-x-auto leading-relaxed whitespace-pre-wrap")
:style "font-size:0.5rem"
(map
@@ -319,12 +333,9 @@
(span :class cls (get tok "text"))))
(deref code-tokens)))
(div
:class "flex items-center justify-center gap-2 md:gap-3"
(~tw :tokens "flex items-center justify-center gap-2 md:gap-3")
(button
:on-click (fn
(e)
(do-back)
)
:on-click (fn (e) (do-back))
:class (str
"px-2 py-1 rounded text-3xl "
(if
@@ -333,15 +344,12 @@
"text-stone-300 cursor-not-allowed"))
"◀")
(span
:class "text-sm text-stone-500 font-mono tabular-nums"
(~tw :tokens "text-sm text-stone-500 font-mono tabular-nums")
(deref step-idx)
" / "
(len (deref steps)))
(button
:on-click (fn
(e)
(do-step)
)
:on-click (fn (e) (do-step))
:class (str
"px-2 py-1 rounded text-3xl "
(if