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

Isomorphic cookie support + stepper cookie persistence

Browse Source 
get-cookie / set-cookie primitives on both server and client:
  - JS: reads/writes document.cookie
  - OCaml: get-cookie reads from _request_cookies hashtable,
    set-cookie is no-op (server sets cookies via HTTP headers)
  - Python bridge: _inject_request_cookies_locked() sends
    (set-request-cookies {:name "val"}) to kernel before page render

Stepper island (home-stepper.sx):
  - Persistence switched from localStorage to cookie (sx-home-stepper)
  - freeze-scope/thaw-from-sx mechanism preserved, just different storage
  - Server reads cookie → thaw restores step-idx → SSR renders correct step
  - Code highlighting: removed imperative code-spans/build-code-dom/
    update-code-highlight; replaced with live DOM query that survives morphs
  - Removed code-view lake wrapper (now plain reactive DOM)

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-24 04:13:53 +00:00
parent e021184935
commit bf305deae1
5 changed files with 120 additions and 96 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
hosts/javascript/platform.py
View File

@@ -1175,6 +1175,18 @@ PRIMITIVES_JS_MODULES: dict[str, str] = {
lst[idx] = val;
return NIL;
};
// Cookie access — isomorphic state persistence
PRIMITIVES["set-cookie"] = function(name, value, days) {
var d = days || 365;
var expires = new Date(Date.now() + d * 864e5).toUTCString();
document.cookie = name + "=" + encodeURIComponent(value) + ";expires=" + expires + ";path=/;SameSite=Lax";
return NIL;
};
PRIMITIVES["get-cookie"] = function(name) {
var m = document.cookie.match(new RegExp("(?:^|;\\\\s*)" + name + "=([^;]*)"));
return m ? decodeURIComponent(m[1]) : NIL;
};
PRIMITIVES["env-parent"] = function(env) {
if (env && Object.getPrototypeOf(env) !== Object.prototype &&
Object.getPrototypeOf(env) !== null)

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

@@ -127,6 +127,23 @@ let io_counter = ref 0
(** Module-level scope stacks — shared between make_server_env (aser
scope-push!/pop!) and step-sf-context (via get-primitive "scope-peek"). *)
(** Request cookies — set by Python bridge before each page render.
get-cookie reads from here on the server; set-cookie is a no-op
(server can't set response cookies from SX — that's the framework's job). *)
let _request_cookies : (string, string) Hashtbl.t = Hashtbl.create 8
let () = Sx_primitives.register "get-cookie" (fun args ->
match args with
| [String name] ->
(match Hashtbl.find_opt _request_cookies name with
| Some v -> String v
| None -> Nil)
| _ -> Nil)
let () = Sx_primitives.register "set-cookie" (fun _args ->
(* No-op on server — cookies are set via HTTP response headers *)
Nil)
let _scope_stacks : (string, value list) Hashtbl.t = Hashtbl.create 8
let () = Sx_primitives.register "scope-push!" (fun args ->
@@ -1205,6 +1222,15 @@ let rec dispatch env cmd =
jit_allowlist := StringSet.add name !jit_allowlist;
send_ok ()
| List [Symbol "set-request-cookies"; Dict cookies] ->
(* Set request cookies for get-cookie primitive.
Called by Python bridge before each page render. *)
Hashtbl.clear _request_cookies;
Hashtbl.iter (fun k v ->
match v with String s -> Hashtbl.replace _request_cookies k s | _ -> ()
) cookies;
send_ok ()
| List [Symbol "aser-slot"; String src] ->
(* Expand ALL components server-side. Uses batch IO mode.
Calls aser via CEK — the JIT hook compiles it on first call. *)

14
shared/static/scripts/sx-browser.js
View File

@@ -14,7 +14,7 @@
// =========================================================================
var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } });
var SX_VERSION = "2026-03-24T02:56:45Z";
var SX_VERSION = "2026-03-24T04:10:36Z";
function isNil(x) { return x === NIL || x === null || x === undefined; }
function isSxTruthy(x) { return x !== false && !isNil(x); }
@@ -555,6 +555,18 @@
lst[idx] = val;
return NIL;
};
// Cookie access — isomorphic state persistence
PRIMITIVES["set-cookie"] = function(name, value, days) {
var d = days || 365;
var expires = new Date(Date.now() + d * 864e5).toUTCString();
document.cookie = name + "=" + encodeURIComponent(value) + ";expires=" + expires + ";path=/;SameSite=Lax";
return NIL;
};
PRIMITIVES["get-cookie"] = function(name) {
var m = document.cookie.match(new RegExp("(?:^|;\\s*)" + name + "=([^;]*)"));
return m ? decodeURIComponent(m[1]) : NIL;
};
PRIMITIVES["env-parent"] = function(env) {
if (env && Object.getPrototypeOf(env) !== Object.prototype &&
Object.getPrototypeOf(env) !== null)

23
shared/sx/ocaml_bridge.py
View File

@@ -205,6 +205,27 @@ class OcamlBridge:
self._shell_statics_injected = True
_logger.info("Injected shell statics into OCaml kernel")
async def _inject_request_cookies_locked(self) -> None:
"""Send current request cookies to kernel for get-cookie primitive."""
try:
from quart import request
cookies = request.cookies
except Exception:
return # no request context (CLI mode, tests)
if not cookies:
return
# Build SX dict: {:name1 "val1" :name2 "val2"}
pairs = []
for k, v in cookies.items():
pairs.append(f':{k} "{_escape(str(v))}"')
if pairs:
cmd = f'(set-request-cookies {{{" ".join(pairs)}}})'
try:
await self._send(cmd)
await self._read_until_ok(ctx=None)
except OcamlBridgeError as e:
_logger.debug("Cookie inject failed: %s", e)
async def sx_page_full(
self,
page_source: str,
@@ -221,6 +242,8 @@ class OcamlBridge:
async with self._lock:
await self._inject_helpers_locked()
await self._inject_shell_statics_locked()
# Send request cookies so get-cookie works during SSR
await self._inject_request_cookies_locked()
# Large/complex blobs use placeholders — OCaml renders the shell
# with short tokens; Python splices in the real values post-render.
# This avoids piping large strings or strings with special chars

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

@@ -1,62 +1,10 @@
;; steps-to-preview — pure function: replay step machine as SX expression tree.
;; Given a list of steps and a target index, build the SX that represents
;; the partial render at that step. Works on both server and client.
(define steps-to-preview
(fn (all-steps target)
(if (or (empty? all-steps) (<= target 0))
nil
;; Use mutable lists for the stacks so append!/init work correctly
(let ((stack (list (list)))
(tag-stack (list)))
;; Replay steps 0..target-1
(for-each (fn (step)
(let ((step-type (get step "type")))
(cond
(= step-type "open")
(do (append! stack (list))
(append! tag-stack (get step "tag")))
(= step-type "close")
(when (> (len stack) 1)
(let ((children (last stack))
(tag (last tag-stack))
(attrs (or (get step "open-attrs") (list)))
(spreads (or (get step "open-spreads") (list)))
(expr (concat (list (make-symbol tag)) attrs spreads children)))
;; Pop stack: remove last, append expr to new last
(set! stack (init stack))
(set! tag-stack (init tag-stack))
(append! (last stack) expr)))
(= step-type "leaf")
(when (not (empty? stack))
(append! (last stack) (get step "expr")))
(= step-type "expr")
(when (not (empty? stack))
(append! (last stack) (get step "expr"))))))
(slice all-steps 0 (min target (len all-steps))))
;; Close any unclosed elements
(let close-loop ()
(when (> (len stack) 1)
(let ((children (last stack))
(tag (last tag-stack))
(expr (concat (list (make-symbol tag)) children)))
(set! stack (init stack))
(set! tag-stack (init tag-stack))
(append! (last stack) expr)
(close-loop))))
;; Return root content
(let ((root (first stack)))
(cond
(= (len root) 1) (first root)
(empty? root) nil
:else (concat (list (make-symbol "<>")) root)))))))
(defisland ~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\")))")
(steps (signal (list)))
(step-idx (signal 9))
(dom-stack-sig (signal (list)))
(code-tokens (signal (list)))
(code-spans (list)))
)
(letrec
((split-tag (fn (expr result)
(cond
@@ -147,7 +95,7 @@
(dict-set! step-ref "v" (+ (get step-ref "v") 1)))))
:else nil)))
(get-preview (fn () (dom-query "[data-sx-lake=\"home-preview\"]")))
(get-code-view (fn () (dom-query "[data-sx-lake=\"code-view\"]")))
(get-code-view (fn () (dom-query "[data-code-view]")))
(get-stack (fn () (deref dom-stack-sig)))
(set-stack (fn (v) (reset! dom-stack-sig v)))
(push-stack (fn (el) (reset! dom-stack-sig (append (deref dom-stack-sig) (list el)))))
@@ -155,35 +103,33 @@
(let ((s (deref dom-stack-sig)))
(when (> (len s) 1)
(reset! dom-stack-sig (slice s 0 (- (len s) 1)))))))
(build-code-dom (fn ()
(when (and (empty? code-spans) (not (empty? (deref code-tokens))))
(let ((code-el (get-code-view)))
(when code-el
(dom-set-prop code-el "innerHTML" "")
(for-each (fn (tok)
(let ((sp (dom-create-element "span" nil)))
(dom-set-attr sp "class" (get tok "cls"))
(dom-set-prop sp "textContent" (get tok "text"))
(dom-append code-el sp)
(append! code-spans (dict "el" sp "step" (get tok "step") "cls" (get tok "cls") "spread" (get tok "spread")))))
(deref code-tokens)))))))
;; build-code-dom and update-code-highlight removed —
;; the code view is now reactive DOM bound to step-idx signal.
;; No imperative DOM manipulation needed.
(build-code-dom (fn () nil))
(update-code-highlight (fn ()
(let ((cur (deref step-idx)))
(for-each (fn (s)
(let ((step-num (get s "step"))
(el (get s "el"))
(base (get s "cls")))
(let ((code-el (get-code-view))
(cur (deref step-idx))
(tokens (deref code-tokens)))
(when (and code-el (not (empty? tokens)))
(let ((spans (dom-query-all code-el "span")))
(for-each (fn (i)
(when (< i (len tokens))
(let ((sp (nth spans i))
(tok (nth tokens i))
(step-num (get tok "step"))
(base (get tok "cls"))
(is-spread (get tok "spread")))
(when (not (= step-num -1))
(dom-set-attr el "class"
(dom-set-attr sp "class"
(str base
(let ((is-spread (get s "spread")))
(cond
(and (= step-num cur) is-spread) " opacity-60"
(= step-num cur) " bg-amber-100 rounded px-0.5 font-bold text-sm"
(and (< step-num cur) is-spread) " opacity-60"
(< step-num cur) " font-bold text-xs"
:else " opacity-40")))))))
code-spans))))
(range 0 (min (len spans) (len tokens)))))))))
(do-step (fn ()
(build-code-dom)
(when (< (deref step-idx) (len (deref steps)))
@@ -227,7 +173,7 @@
(dom-append parent rendered)))))
(swap! step-idx inc)
(update-code-highlight)
(local-storage-set "sx-home-stepper" (freeze-to-sx "home-stepper")))))
(set-cookie "sx-home-stepper" (freeze-to-sx "home-stepper")))))
(do-back (fn ()
(when (> (deref step-idx) 0)
(let ((target (- (deref step-idx) 1))
@@ -236,15 +182,14 @@
(set-stack (list (get-preview)))
(reset! step-idx 0)
(for-each (fn (_) (do-step)) (slice (deref steps) 0 target))
(local-storage-set "sx-home-stepper" (freeze-to-sx "home-stepper")))))))
;; Freeze scope for persistence
(set-cookie "sx-home-stepper" (freeze-to-sx "home-stepper")))))))
;; Freeze scope for persistence — same mechanism, cookie storage
(freeze-scope "home-stepper" (fn ()
(freeze-signal "step" step-idx)))
;; Restore from localStorage on mount
(let ((saved (local-storage-get "sx-home-stepper")))
;; Restore from cookie on mount (server reads cookie too for SSR)
(let ((saved (get-cookie "sx-home-stepper")))
(when saved
(thaw-from-sx saved)
;; Validate — reset to default if out of range
(when (or (< (deref step-idx) 0) (> (deref step-idx) 16))
(reset! step-idx 9))))
;; Parse source eagerly (pure computation — works in SSR and client)
@@ -272,9 +217,9 @@
(run-post-render-hooks)))))))
(div :class "space-y-4"
;; Code view lake — SSR renders tokenized code with highlighting
(div (~cssx/tw :tokens "font-mono bg-stone-50 rounded p-2 overflow-x-auto leading-relaxed whitespace-pre-wrap")
(div :data-code-view true
(~cssx/tw :tokens "font-mono bg-stone-50 rounded p-2 overflow-x-auto leading-relaxed whitespace-pre-wrap")
:style "font-size:0.5rem"
(lake :id "code-view"
(map (fn (tok)
(let ((step (get tok "step"))
(cur (deref step-idx))
@@ -288,7 +233,7 @@
(< step cur) " font-bold text-xs"
:else " opacity-40"))))
(span :class cls (get tok "text"))))
(deref code-tokens))))
(deref code-tokens)))
;; Controls
(div :class "flex items-center justify-center gap-2 md:gap-3"
(button :on-click (fn (e) (do-back))
@@ -305,8 +250,14 @@
"text-violet-600 hover:text-violet-800 hover:bg-violet-50"
"text-violet-300 cursor-not-allowed"))
"\u25b6"))
;; Live preview — declarative: same SX rendered by server (HTML) and client (DOM).
;; steps-to-preview replays the stack machine as SX expressions.
;; Live preview lake — client builds incrementally via do-step effect.
;; SSR shows the full result; client effect replays 0→N for animation.
(lake :id "home-preview"
(steps-to-preview (deref steps) (deref step-idx))))))))
(div (~cssx/tw :tokens "text-center")
(h1 (~cssx/tw :tokens "text-3xl font-bold mb-2")
(span (~cssx/tw :tokens "text-rose-500") "the ")
(span (~cssx/tw :tokens "text-amber-500") "joy ")
(span (~cssx/tw :tokens "text-emerald-500") "of ")
(span (~cssx/tw :tokens "text-violet-600 text-4xl") "sx")))))))))