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

141
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")))
(when (not (= step-num -1))
(dom-set-attr el "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))))
(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 sp "class"
(str base
(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")))))))
(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,10 +217,10 @@
(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)
(map (fn (tok)
(let ((step (get tok "step"))
(cur (deref step-idx))
(is-spread (get tok "spread"))
@@ -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")))))))))