giles
71c2003a60
Major architectural change: page function dispatch and handler execution
now go through the OCaml kernel instead of the Python bootstrapped evaluator.
OCaml integration:
- Page dispatch: bridge.eval() evaluates SX URL expressions (geography, marshes, etc.)
- Handler aser: bridge.aser() serializes handler responses as SX wire format
- _ensure_components loads all .sx files into OCaml kernel (spec, web adapter, handlers)
- defhandler/defpage registered as no-op special forms so handler files load
- helper IO primitive dispatches to Python page helpers + IO handlers
- ok-raw response format for SX wire format (no double-escaping)
- Natural list serialization in eval (no (list ...) wrapper)
- Clean pipe: _read_until_ok always sends io-response on error
SX adapter (aser):
- scope-emit!/scope-peek aliases to avoid CEK special form conflict
- aser-fragment/aser-call: strings starting with "(" pass through unserialized
- Registered cond-scheme?, is-else-clause?, primitive?, get-primitive in kernel
- random-int, parse-int as kernel primitives; json-encode, into via IO bridge
Handler migration:
- All IO calls converted to (helper "name" args...) pattern
- request-arg, request-form, state-get, state-set!, now, component-source etc.
- Fixed bare (effect ...) in island bodies leaking disposer functions as text
- Fixed lower-case → lower, ~search-results → ~examples/search-results
Reactive islands:
- sx-hydrate-islands called after client-side navigation swap
- force-dispose-islands-in for outerHTML swaps (clears hydration markers)
- clear-processed! platform primitive for re-hydration
Content restructuring:
- Design, event bridge, named stores, phase 2 consolidated into reactive overview
- Marshes split into overview + 5 example sub-pages
- Nav links use sx-get/sx-target for client-side navigation
Playwright test suite (sx/tests/test_demos.py):
- 83 tests covering hypermedia demos, reactive islands, marshes, spec explorer
- Server-side rendering, handler interactions, island hydration, navigation
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
245 lines
13 KiB
Plaintext
245 lines
13 KiB
Plaintext
(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
|
|
(not (list? expr))
|
|
(append! result {"type" "leaf" "expr" expr})
|
|
(empty? expr) nil
|
|
(not (= (type-of (first expr)) "symbol"))
|
|
(append! result {"type" "leaf" "expr" expr})
|
|
(is-html-tag? (symbol-name (first expr)))
|
|
(let ((ctag (symbol-name (first expr)))
|
|
(cargs (rest expr))
|
|
(cch (list))
|
|
(cat (list))
|
|
(spreads (list))
|
|
(ckw false))
|
|
(for-each (fn (a)
|
|
(cond
|
|
(= (type-of a) "keyword") (do (set! ckw true) (append! cat a))
|
|
ckw (do (set! ckw false) (append! cat a))
|
|
(and (list? a) (not (empty? a))
|
|
(= (type-of (first a)) "symbol")
|
|
(starts-with? (symbol-name (first a)) "~"))
|
|
(do (set! ckw false) (append! spreads a))
|
|
:else (do (set! ckw false) (append! cch a))))
|
|
cargs)
|
|
(append! result {"type" "open" "tag" ctag "attrs" cat "spreads" spreads})
|
|
(for-each (fn (c) (split-tag c result)) cch)
|
|
(append! result {"type" "close" "tag" ctag}))
|
|
:else
|
|
(append! result {"type" "expr" "expr" expr}))))
|
|
(build-code-tokens (fn (expr tokens step-ref indent)
|
|
(cond
|
|
(string? expr)
|
|
(do (append! tokens {"text" (str "\"" expr "\"") "cls" "text-emerald-700" "step" (get step-ref "v")})
|
|
(dict-set! step-ref "v" (+ (get step-ref "v") 1)))
|
|
(number? expr)
|
|
(do (append! tokens {"text" (str expr) "cls" "text-amber-700" "step" (get step-ref "v")})
|
|
(dict-set! step-ref "v" (+ (get step-ref "v") 1)))
|
|
(= (type-of expr) "keyword")
|
|
(append! tokens {"text" (str ":" (keyword-name expr)) "cls" "text-violet-600" "step" (get step-ref "v")})
|
|
(= (type-of expr) "symbol")
|
|
(let ((name (symbol-name expr)))
|
|
(append! tokens {"text" name "cls"
|
|
(cond
|
|
(is-html-tag? name) "text-sky-700 font-semibold"
|
|
(starts-with? name "~") "text-rose-600 font-semibold"
|
|
:else "text-stone-700")
|
|
"step" (get step-ref "v")}))
|
|
(list? expr)
|
|
(when (not (empty? expr))
|
|
(let ((head (first expr))
|
|
(is-tag (and (= (type-of head) "symbol") (is-html-tag? (symbol-name head))))
|
|
(is-comp (and (= (type-of head) "symbol") (starts-with? (symbol-name head) "~")))
|
|
(open-step (get step-ref "v")))
|
|
(append! tokens {"text" "(" "cls" "text-stone-400" "step" open-step})
|
|
(build-code-tokens head tokens step-ref indent)
|
|
(when is-tag
|
|
(dict-set! step-ref "v" (+ (get step-ref "v") 1)))
|
|
(for-each (fn (a)
|
|
(let ((is-child (and (list? a) (not (empty? a))
|
|
(= (type-of (first a)) "symbol")
|
|
(or (is-html-tag? (symbol-name (first a)))
|
|
(starts-with? (symbol-name (first a)) "~"))))
|
|
(is-spread (and (list? a) (not (empty? a))
|
|
(= (type-of (first a)) "symbol")
|
|
(starts-with? (symbol-name (first a)) "~"))))
|
|
(if is-spread
|
|
;; Component spread: save counter, process, restore
|
|
;; All tokens inside share parent open-step
|
|
(let ((saved (get step-ref "v"))
|
|
(saved-tokens-len (len tokens)))
|
|
(append! tokens {"text" " " "cls" "" "step" -1})
|
|
(build-code-tokens a tokens step-ref indent)
|
|
;; Mark all tokens added during spread as spread tokens
|
|
(let mark-loop ((j saved-tokens-len))
|
|
(when (< j (len tokens))
|
|
(dict-set! (nth tokens j) "spread" true)
|
|
(mark-loop (+ j 1))))
|
|
(dict-set! step-ref "v" saved))
|
|
(if (and is-tag is-child)
|
|
(do (append! tokens {"text" (str "\n" (join "" (map (fn (_) " ") (range 0 (+ indent 1))))) "cls" "" "step" -1})
|
|
(build-code-tokens a tokens step-ref (+ indent 1)))
|
|
(do (append! tokens {"text" " " "cls" "" "step" -1})
|
|
(build-code-tokens a tokens step-ref indent))))))
|
|
(rest expr))
|
|
(append! tokens {"text" ")" "cls" "text-stone-400" "step" open-step})
|
|
(when is-tag
|
|
(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-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)))))
|
|
(pop-stack (fn ()
|
|
(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)))))))
|
|
(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))))
|
|
(do-step (fn ()
|
|
(build-code-dom)
|
|
(when (< (deref step-idx) (len (deref steps)))
|
|
(when (empty? (get-stack))
|
|
(let ((p (get-preview)))
|
|
(when p (set-stack (list p)))))
|
|
(let ((step (nth (deref steps) (deref step-idx)))
|
|
(step-type (get step "type"))
|
|
(parent (if (empty? (get-stack)) (get-preview) (last (get-stack)))))
|
|
(cond
|
|
(= step-type "open")
|
|
(let ((el (dom-create-element (get step "tag") nil))
|
|
(attrs (get step "attrs"))
|
|
(spreads (or (get step "spreads") (list))))
|
|
(let loop ((i 0))
|
|
(when (< i (len attrs))
|
|
(dom-set-attr el (keyword-name (nth attrs i)) (nth attrs (+ i 1)))
|
|
(loop (+ i 2))))
|
|
(for-each (fn (sp)
|
|
(let ((result (eval-expr sp (make-env))))
|
|
(when (and result (spread? result))
|
|
(let ((sattrs (spread-attrs result)))
|
|
(for-each (fn (k)
|
|
(if (= k "class")
|
|
(dom-set-attr el "class"
|
|
(str (or (dom-get-attr el "class") "") " " (get sattrs k)))
|
|
(dom-set-attr el k (get sattrs k))))
|
|
(keys sattrs))))))
|
|
spreads)
|
|
(when parent (dom-append parent el))
|
|
(push-stack el))
|
|
(= step-type "close")
|
|
(pop-stack)
|
|
(= step-type "leaf")
|
|
(when parent
|
|
(let ((val (get step "expr")))
|
|
(dom-append parent (create-text-node (if (string? val) val (str val))))))
|
|
(= step-type "expr")
|
|
(let ((rendered (render-to-dom (get step "expr") (make-env) nil)))
|
|
(when (and parent rendered)
|
|
(dom-append parent rendered)))))
|
|
(swap! step-idx inc)
|
|
(update-code-highlight)
|
|
(local-storage-set "sx-home-stepper" (freeze-to-sx "home-stepper")))))
|
|
(do-back (fn ()
|
|
(when (> (deref step-idx) 0)
|
|
(let ((target (- (deref step-idx) 1))
|
|
(container (get-preview)))
|
|
(when container (dom-set-prop container "innerHTML" ""))
|
|
(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
|
|
(freeze-scope "home-stepper" (fn ()
|
|
(freeze-signal "step" step-idx)))
|
|
;; Restore from localStorage on mount
|
|
(let ((saved (local-storage-get "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))))
|
|
;; Auto-parse via effect (bind to _ to suppress return value in DOM)
|
|
(let ((_eff (effect (fn ()
|
|
(let ((parsed (sx-parse source)))
|
|
(when (not (empty? parsed))
|
|
(let ((result (list))
|
|
(step-ref (dict "v" 0)))
|
|
(split-tag (first parsed) result)
|
|
(reset! steps result)
|
|
(let ((tokens (list)))
|
|
(dict-set! step-ref "v" 0)
|
|
(build-code-tokens (first parsed) tokens step-ref 0)
|
|
(reset! code-tokens tokens))
|
|
;; Defer code DOM build until lake exists
|
|
(schedule-idle (fn ()
|
|
(build-code-dom)
|
|
;; Clear preview and replay to initial step-idx
|
|
(let ((preview (get-preview)))
|
|
(when preview (dom-set-prop preview "innerHTML" "")))
|
|
(let ((target (deref step-idx)))
|
|
(reset! step-idx 0)
|
|
(set-stack (list (get-preview)))
|
|
(for-each (fn (_) (do-step)) (slice (deref steps) 0 target)))
|
|
(update-code-highlight)
|
|
(run-post-render-hooks))))))))))
|
|
(div :class "space-y-4"
|
|
;; Code view lake — spans built imperatively, classes updated on step
|
|
(div (~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"))
|
|
;; Controls
|
|
(div :class "flex items-center justify-center gap-2 md:gap-3"
|
|
(button :on-click (fn (e) (do-back))
|
|
:class (str "px-2 py-1 rounded text-3xl "
|
|
(if (> (deref step-idx) 0)
|
|
"text-stone-600 hover:text-stone-800 hover:bg-stone-100"
|
|
"text-stone-300 cursor-not-allowed"))
|
|
"\u25c0")
|
|
(span :class "text-sm text-stone-500 font-mono tabular-nums"
|
|
(deref step-idx) " / " (len (deref steps)))
|
|
(button :on-click (fn (e) (do-step))
|
|
:class (str "px-2 py-1 rounded text-3xl "
|
|
(if (< (deref step-idx) (len (deref steps)))
|
|
"text-violet-600 hover:text-violet-800 hover:bg-violet-50"
|
|
"text-violet-300 cursor-not-allowed"))
|
|
"\u25b6"))
|
|
;; Live preview lake
|
|
(lake :id "home-preview"))))))
|