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

WIP: DOM-preserving hydration — SSR DOM stays, no visual flash

Browse Source 
Adds hydration cursor to render pipeline:
- boot.sx: *hydrating* flag, hydrate-start!/stop!, cursor stack helpers
- adapter-dom.sx: render-dom-element uses existing SSR elements when
  *hydrating* is true. Text nodes reused. dom-append skipped.
- hydrate-island: calls hydrate-start! before render-to-dom, no
  replaceChildren. SSR DOM stays in place.

Status: screenshots identical (no visual flash), but event listeners
not attaching — the cursor/set! interaction between CEK and VM needs
debugging. The hydrate-start! set! on *hydrating* may not propagate
to the bytecoded adapter-dom render path.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-10 10:40:09 +00:00
parent 3d05efbb9b
commit 0044f17e4c
6 changed files with 2658 additions and 2546 deletions
Download Patch File Download Diff File Expand all files Collapse all files

177
shared/static/wasm/sx/adapter-dom.sx
View File

@@ -1,16 +1,48 @@
(import (sx dom)) (import (sx dom))
(import (sx render)) (import (sx render))
(define-library (web adapter-dom) (define-library
(export SVG_NS MATH_NS island-scope? contains-deref? dom-on render-to-dom render-dom-list render-dom-element render-dom-component render-dom-fragment render-dom-raw render-dom-unknown-component RENDER_DOM_FORMS render-dom-form? dispatch-render-form render-lambda-dom render-dom-island render-dom-lake render-dom-marsh reactive-text reactive-attr reactive-spread reactive-fragment render-list-item extract-key reactive-list bind-input *use-cek-reactive* enable-cek-reactive! cek-reactive-text cek-reactive-attr render-dom-portal render-dom-error-boundary) (web adapter-dom)
(export
SVG_NS
MATH_NS
island-scope?
contains-deref?
dom-on
render-to-dom
render-dom-list
render-dom-element
render-dom-component
render-dom-fragment
render-dom-raw
render-dom-unknown-component
RENDER_DOM_FORMS
render-dom-form?
dispatch-render-form
render-lambda-dom
render-dom-island
render-dom-lake
render-dom-marsh
reactive-text
reactive-attr
reactive-spread
reactive-fragment
render-list-item
extract-key
reactive-list
bind-input
*use-cek-reactive*
enable-cek-reactive!
cek-reactive-text
cek-reactive-attr
render-dom-portal
render-dom-error-boundary)
(begin (begin
(define SVG_NS "http://www.w3.org/2000/svg") (define SVG_NS "http://www.w3.org/2000/svg")
(define MATH_NS "http://www.w3.org/1998/Math/MathML") (define MATH_NS "http://www.w3.org/1998/Math/MathML")
(define
(define island-scope? (fn () (not (nil? (scope-peek "sx-island-scope"))))) island-scope?
(fn () (not (nil? (scope-peek "sx-island-scope")))))
(begin (begin
(define *memo-cache* (dict)) (define *memo-cache* (dict))
(define *cyst-counter* 0) (define *cyst-counter* 0)
@@ -20,7 +52,6 @@
() ()
(set! *cyst-counter* (+ *cyst-counter* 1)) (set! *cyst-counter* (+ *cyst-counter* 1))
(str "sx-cyst-" *cyst-counter*)))) (str "sx-cyst-" *cyst-counter*))))
(define (define
contains-deref? contains-deref?
(fn (fn
@@ -37,7 +68,6 @@
(= (symbol-name (first expr)) "deref")) (= (symbol-name (first expr)) "deref"))
true true
(some contains-deref? expr)))))) (some contains-deref? expr))))))
(define (define
dom-on dom-on
:effects (io) :effects (io)
@@ -59,7 +89,6 @@
(trampoline (call-lambda handler (list e))) (trampoline (call-lambda handler (list e)))
(run-post-render-hooks))) (run-post-render-hooks)))
handler)))) handler))))
(define (define
render-to-dom render-to-dom
:effects (render) :effects (render)
@@ -75,9 +104,15 @@
"raw-html" "raw-html"
(dom-parse-html (raw-html-content expr)) (dom-parse-html (raw-html-content expr))
"string" "string"
(create-text-node expr) (if
*hydrating*
(or (hydrate-next-text!) (create-text-node expr))
(create-text-node expr))
"number" "number"
(create-text-node (str expr)) (if
*hydrating*
(or (hydrate-next-text!) (create-text-node (str expr)))
(create-text-node (str expr)))
"symbol" "symbol"
(render-to-dom (trampoline (eval-expr expr env)) env ns) (render-to-dom (trampoline (eval-expr expr env)) env ns)
"keyword" "keyword"
@@ -101,7 +136,6 @@
(reactive-text expr) (reactive-text expr)
(create-text-node (str (deref expr)))) (create-text-node (str (deref expr))))
(create-text-node (str expr)))))) (create-text-node (str expr))))))
(define (define
render-dom-list render-dom-list
:effects (render) :effects (render)
@@ -136,7 +170,10 @@
(render-dom-element name args env ns) (render-dom-element name args env ns)
(dispatch-render-form name expr env ns)) (dispatch-render-form name expr env ns))
(and (env-has? env name) (macro? (env-get env name))) (and (env-has? env name) (macro? (env-get env name)))
(render-to-dom (expand-macro (env-get env name) args env) env ns) (render-to-dom
(expand-macro (env-get env name) args env)
env
ns)
(contains? HTML_TAGS name) (contains? HTML_TAGS name)
(render-dom-element name args env ns) (render-dom-element name args env ns)
(and (and
@@ -156,7 +193,12 @@
((skip (get state "skip"))) ((skip (get state "skip")))
(if (if
skip skip
(assoc state "skip" false "i" (inc (get state "i"))) (assoc
state
"skip"
false
"i"
(inc (get state "i")))
(if (if
(and (and
(= (type-of arg) "keyword") (= (type-of arg) "keyword")
@@ -178,7 +220,10 @@
(assoc state "i" (inc (get state "i"))))))) (assoc state "i" (inc (get state "i")))))))
(dict "i" 0 "skip" false) (dict "i" 0 "skip" false)
args) args)
(dom-set-attr marker "data-sx-island" (component-name island)) (dom-set-attr
marker
"data-sx-island"
(component-name island))
(when (when
(not (empty-dict? kw-state)) (not (empty-dict? kw-state))
(dom-set-attr (dom-set-attr
@@ -224,15 +269,21 @@
(when (not (spread? result)) (dom-append frag result)))) (when (not (spread? result)) (dom-append frag result))))
expr) expr)
frag))))) frag)))))
(define (define
render-dom-element render-dom-element
:effects (render) :effects (render)
(fn (fn
((tag :as string) (args :as list) (env :as dict) (ns :as string)) ((tag :as string) (args :as list) (env :as dict) (ns :as string))
(let (let
((new-ns (cond (= tag "svg") SVG_NS (= tag "math") MATH_NS :else ns)) ((new-ns (if (= tag "svg") SVG_NS (if (= tag "math") MATH_NS ns)))
(el (dom-create-element tag new-ns))) (el
(if
*hydrating*
(let
((existing (hydrate-next-element!)))
(when existing (hydrate-push! existing))
(or existing (dom-create-element tag new-ns)))
(dom-create-element tag new-ns))))
(scope-push! "element-attrs" nil) (scope-push! "element-attrs" nil)
(reduce (reduce
(fn (fn
@@ -296,7 +347,7 @@
(fn () (render-to-dom arg env new-ns))) (fn () (render-to-dom arg env new-ns)))
(spread? child) (spread? child)
nil nil
:else (dom-append el child)))) :else (when (not *hydrating*) (dom-append el child)))))
(assoc state "i" (inc (get state "i")))))))) (assoc state "i" (inc (get state "i"))))))))
(dict "i" 0 "skip" false) (dict "i" 0 "skip" false)
args) args)
@@ -334,13 +385,15 @@
(keys spread-dict))) (keys spread-dict)))
(scope-emitted "element-attrs")) (scope-emitted "element-attrs"))
(scope-pop! "element-attrs") (scope-pop! "element-attrs")
el))) (do (when *hydrating* (hydrate-pop!)) el))))
(define (define
render-dom-component render-dom-component
:effects (render) :effects (render)
(fn (fn
((comp :as component) (args :as list) (env :as dict) (ns :as string)) ((comp :as component)
(args :as list)
(env :as dict)
(ns :as string))
(let (let
((kwargs (dict)) (children (list))) ((kwargs (dict)) (children (list)))
(reduce (reduce
@@ -389,7 +442,6 @@
children) children)
(env-bind! local "children" child-frag))) (env-bind! local "children" child-frag)))
(render-to-dom (component-body comp) local ns))))) (render-to-dom (component-body comp) local ns)))))
(define (define
render-dom-fragment render-dom-fragment
:effects (render) :effects (render)
@@ -405,7 +457,6 @@
(when (not (spread? result)) (dom-append frag result)))) (when (not (spread? result)) (dom-append frag result))))
args) args)
frag))) frag)))
(define (define
render-dom-raw render-dom-raw
:effects (render) :effects (render)
@@ -427,12 +478,10 @@
(dom-append frag (create-text-node (str val)))))) (dom-append frag (create-text-node (str val))))))
args) args)
frag))) frag)))
(define (define
render-dom-unknown-component render-dom-unknown-component
:effects (render) :effects (render)
(fn ((name :as string)) (error (str "Unknown component: " name)))) (fn ((name :as string)) (error (str "Unknown component: " name))))
(define (define
RENDER_DOM_FORMS RENDER_DOM_FORMS
(list (list
@@ -459,12 +508,10 @@
"scope" "scope"
"provide" "provide"
"cyst")) "cyst"))
(define (define
render-dom-form? render-dom-form?
:effects () :effects ()
(fn ((name :as string)) (contains? RENDER_DOM_FORMS name))) (fn ((name :as string)) (contains? RENDER_DOM_FORMS name)))
(define (define
dispatch-render-form dispatch-render-form
:effects (render) :effects (render)
@@ -555,7 +602,9 @@
(for-each (for-each
(fn (fn
(i) (i)
(dom-append frag (render-to-dom (nth expr i) env ns))) (dom-append
frag
(render-to-dom (nth expr i) env ns)))
(range 2 (len expr))) (range 2 (len expr)))
(set! current-nodes (dom-child-nodes frag)) (set! current-nodes (dom-child-nodes frag))
(set! initial-result frag)))))) (set! initial-result frag))))))
@@ -670,7 +719,9 @@
bindings) bindings)
(when (when
(> (len body) 1) (> (len body) 1)
(for-each (fn (e) (trampoline (eval-expr e local))) (init body))) (for-each
(fn (e) (trampoline (eval-expr e local)))
(init body)))
(render-to-dom (last body) local ns)) (render-to-dom (last body) local ns))
(or (= name "begin") (= name "do")) (or (= name "begin") (= name "do"))
(if (if
@@ -771,7 +822,9 @@
(= (type-of (first rest-args)) "keyword") (= (type-of (first rest-args)) "keyword")
(= (keyword-name (first rest-args)) "value")) (= (keyword-name (first rest-args)) "value"))
(do (do
(set! scope-val (trampoline (eval-expr (nth rest-args 1) env))) (set!
scope-val
(trampoline (eval-expr (nth rest-args 1) env)))
(set! body-exprs (slice rest-args 2))) (set! body-exprs (slice rest-args 2)))
(set! body-exprs rest-args)) (set! body-exprs rest-args))
(scope-push! scope-name scope-val) (scope-push! scope-name scope-val)
@@ -787,7 +840,9 @@
(frag (create-fragment))) (frag (create-fragment)))
(scope-push! prov-name prov-val) (scope-push! prov-name prov-val)
(for-each (for-each
(fn (i) (dom-append frag (render-to-dom (nth expr i) env ns))) (fn
(i)
(dom-append frag (render-to-dom (nth expr i) env ns)))
(range 3 (len expr))) (range 3 (len expr)))
(scope-pop! prov-name) (scope-pop! prov-name)
frag) frag)
@@ -817,7 +872,6 @@
(dict-set! *memo-cache* cyst-key container) (dict-set! *memo-cache* cyst-key container)
container)))) container))))
:else (render-to-dom (trampoline (eval-expr expr env)) env ns)))) :else (render-to-dom (trampoline (eval-expr expr env)) env ns))))
(define (define
render-lambda-dom render-lambda-dom
:effects (render) :effects (render)
@@ -829,12 +883,14 @@
(fn (i p) (env-bind! local p (nth args i))) (fn (i p) (env-bind! local p (nth args i)))
(lambda-params f)) (lambda-params f))
(render-to-dom (lambda-body f) local ns)))) (render-to-dom (lambda-body f) local ns))))
(define (define
render-dom-island render-dom-island
:effects (render mutation) :effects (render mutation)
(fn (fn
((island :as island) (args :as list) (env :as dict) (ns :as string)) ((island :as island)
(args :as list)
(env :as dict)
(ns :as string))
(let (let
((kwargs (dict)) (children (list))) ((kwargs (dict)) (children (list)))
(reduce (reduce
@@ -878,19 +934,22 @@
children) children)
(env-bind! local "children" child-frag))) (env-bind! local "children" child-frag)))
(let (let
((container (dom-create-element "span" nil)) (disposers (list))) ((container (dom-create-element "span" nil))
(disposers (list)))
(begin (begin
(dom-set-attr container "data-sx-island" island-name) (dom-set-attr container "data-sx-island" island-name)
(when (when
(not (empty-dict? kwargs)) (not (empty-dict? kwargs))
(dom-set-attr container "data-sx-state" (sx-serialize kwargs)))) (dom-set-attr
container
"data-sx-state"
(sx-serialize kwargs))))
(mark-processed! container "island-hydrated") (mark-processed! container "island-hydrated")
(let (let
((body-dom (with-island-scope (fn (disposable) (append! disposers disposable)) (fn () (render-to-dom (component-body island) local ns))))) ((body-dom (with-island-scope (fn (disposable) (append! disposers disposable)) (fn () (render-to-dom (component-body island) local ns)))))
(dom-append container body-dom) (dom-append container body-dom)
(dom-set-data container "sx-disposers" disposers) (dom-set-data container "sx-disposers" disposers)
container)))))) container))))))
(define (define
render-dom-lake render-dom-lake
:effects (render) :effects (render)
@@ -933,7 +992,6 @@
(fn (c) (dom-append el (render-to-dom c env ns))) (fn (c) (dom-append el (render-to-dom c env ns)))
children) children)
el)))) el))))
(define (define
render-dom-marsh render-dom-marsh
:effects (render) :effects (render)
@@ -985,17 +1043,15 @@
(fn (c) (dom-append el (render-to-dom c env ns))) (fn (c) (dom-append el (render-to-dom c env ns)))
children) children)
el)))) el))))
(define (define
reactive-text reactive-text
:effects (render mutation) :effects (render mutation)
(fn (fn
(sig) (sig)
(let (let
((node (create-text-node (str (deref sig))))) ((node (if *hydrating* (or (hydrate-next-text!) (create-text-node (str (deref sig)))) (create-text-node (str (deref sig))))))
(effect (fn () (dom-set-text-content node (str (deref sig))))) (effect (fn () (dom-set-text-content node (str (deref sig)))))
node))) node)))
(define (define
reactive-attr reactive-attr
:effects (render mutation) :effects (render mutation)
@@ -1019,7 +1075,6 @@
(= val true) (= val true)
(dom-set-attr el attr-name "") (dom-set-attr el attr-name "")
:else (dom-set-attr el attr-name (str val))))))))) :else (dom-set-attr el attr-name (str val)))))))))
(define (define
reactive-spread reactive-spread
:effects (render mutation) :effects (render mutation)
@@ -1044,7 +1099,9 @@
(filter (fn (c) (not (= c ""))) (split current " "))) (filter (fn (c) (not (= c ""))) (split current " ")))
(kept (kept
(filter (filter
(fn (c) (not (some (fn (pc) (= pc c)) prev-classes))) (fn
(c)
(not (some (fn (pc) (= pc c)) prev-classes)))
tokens))) tokens)))
(if (if
(empty? kept) (empty? kept)
@@ -1059,7 +1116,9 @@
((attrs (spread-attrs result)) ((attrs (spread-attrs result))
(cls-str (or (dict-get attrs "class") "")) (cls-str (or (dict-get attrs "class") ""))
(new-classes (new-classes
(filter (fn (c) (not (= c ""))) (split cls-str " "))) (filter
(fn (c) (not (= c "")))
(split cls-str " ")))
(extra-keys (extra-keys
(filter (fn (k) (not (= k "class"))) (keys attrs)))) (filter (fn (k) (not (= k "class"))) (keys attrs))))
(set! prev-classes new-classes) (set! prev-classes new-classes)
@@ -1079,8 +1138,9 @@
(fn (k) (dom-set-attr el k (str (dict-get attrs k)))) (fn (k) (dom-set-attr el k (str (dict-get attrs k))))
extra-keys) extra-keys)
(run-post-render-hooks)) (run-post-render-hooks))
(do (set! prev-classes (list)) (set! prev-extra-keys (list)))))))))) (do
(set! prev-classes (list))
(set! prev-extra-keys (list))))))))))
(define (define
reactive-fragment reactive-fragment
:effects (render mutation) :effects (render mutation)
@@ -1090,7 +1150,8 @@
(env :as dict) (env :as dict)
(ns :as string)) (ns :as string))
(let (let
((marker (create-comment "island-fragment")) (current-nodes (list))) ((marker (create-comment "island-fragment"))
(current-nodes (list)))
(effect (effect
(fn (fn
() ()
@@ -1103,7 +1164,6 @@
(set! current-nodes (dom-child-nodes frag)) (set! current-nodes (dom-child-nodes frag))
(dom-insert-after marker frag))))) (dom-insert-after marker frag)))))
marker))) marker)))
(define (define
render-list-item render-list-item
:effects (render) :effects (render)
@@ -1113,7 +1173,6 @@
(lambda? map-fn) (lambda? map-fn)
(render-lambda-dom map-fn (list item) env ns) (render-lambda-dom map-fn (list item) env ns)
(render-to-dom (apply map-fn (list item)) env ns)))) (render-to-dom (apply map-fn (list item)) env ns))))
(define (define
extract-key extract-key
:effects (render) :effects (render)
@@ -1127,7 +1186,6 @@
(let (let
((dk (dom-get-data node "key"))) ((dk (dom-get-data node "key")))
(if dk (str dk) (str "__idx_" index))))))) (if dk (str dk) (str "__idx_" index)))))))
(define (define
reactive-list reactive-list
:effects (render mutation) :effects (render mutation)
@@ -1212,7 +1270,6 @@
(dom-append container rendered))) (dom-append container rendered)))
items))))) items)))))
container))) container)))
(define (define
bind-input bind-input
:effects (render mutation) :effects (render mutation)
@@ -1220,7 +1277,8 @@
(el (sig :as signal)) (el (sig :as signal))
(let (let
((input-type (lower (or (dom-get-attr el "type") ""))) ((input-type (lower (or (dom-get-attr el "type") "")))
(is-checkbox (or (= input-type "checkbox") (= input-type "radio")))) (is-checkbox
(or (= input-type "checkbox") (= input-type "radio"))))
(if (if
is-checkbox is-checkbox
(dom-set-prop el "checked" (deref sig)) (dom-set-prop el "checked" (deref sig))
@@ -1245,11 +1303,8 @@
is-checkbox is-checkbox
(reset! sig (dom-get-prop el "checked")) (reset! sig (dom-get-prop el "checked"))
(reset! sig (dom-get-prop el "value")))))))) (reset! sig (dom-get-prop el "value"))))))))
(define *use-cek-reactive* true) (define *use-cek-reactive* true)
(define enable-cek-reactive! (fn () (set! *use-cek-reactive* true))) (define enable-cek-reactive! (fn () (set! *use-cek-reactive* true)))
(define (define
cek-reactive-text cek-reactive-text
:effects (render mutation) :effects (render mutation)
@@ -1262,7 +1317,6 @@
((initial (cek-run (make-cek-state expr env (list (make-reactive-reset-frame env update-fn true)))))) ((initial (cek-run (make-cek-state expr env (list (make-reactive-reset-frame env update-fn true))))))
(dom-set-text-content node (str initial)) (dom-set-text-content node (str initial))
node)))) node))))
(define (define
cek-reactive-attr cek-reactive-attr
:effects (render mutation) :effects (render mutation)
@@ -1278,7 +1332,6 @@
(let (let
((initial (cek-run (make-cek-state expr env (list (make-reactive-reset-frame env update-fn true)))))) ((initial (cek-run (make-cek-state expr env (list (make-reactive-reset-frame env update-fn true))))))
(cek-call update-fn (list initial)))))) (cek-call update-fn (list initial))))))
(define (define
render-dom-portal render-dom-portal
:effects (render) :effects (render)
@@ -1302,7 +1355,6 @@
(register-in-scope (register-in-scope
(fn () (for-each (fn (n) (dom-remove n)) portal-nodes)))) (fn () (for-each (fn (n) (dom-remove n)) portal-nodes))))
marker))))) marker)))))
(define (define
render-dom-error-boundary render-dom-error-boundary
:effects (render) :effects (render)
@@ -1342,10 +1394,7 @@
(let (let
((fallback-dom (if (nil? fallback-fn) (let ((el (dom-create-element "div" nil))) (dom-set-attr el "class" "sx-render-error") (dom-set-attr el "style" "color:red;font-size:0.875rem;padding:0.5rem;border:1px solid red;border-radius:0.25rem;margin:0.5rem 0;") (dom-set-text-content el (str "Render error: " err)) el) (if (lambda? fallback-fn) (render-lambda-dom fallback-fn (list err retry-fn) env ns) (render-to-dom (apply fallback-fn (list err retry-fn)) env ns))))) ((fallback-dom (if (nil? fallback-fn) (let ((el (dom-create-element "div" nil))) (dom-set-attr el "class" "sx-render-error") (dom-set-attr el "style" "color:red;font-size:0.875rem;padding:0.5rem;border:1px solid red;border-radius:0.25rem;margin:0.5rem 0;") (dom-set-text-content el (str "Render error: " err)) el) (if (lambda? fallback-fn) (render-lambda-dom fallback-fn (list err retry-fn) env ns) (render-to-dom (apply fallback-fn (list err retry-fn)) env ns)))))
(dom-append container fallback-dom))))))) (dom-append container fallback-dom)))))))
container))) container)))))
))
;; Re-export to global env ;; Re-export to global env
(import (web adapter-dom)) (import (web adapter-dom))

4
shared/static/wasm/sx/adapter-dom.sxbc
View File

File diff suppressed because one or more lines are too long

13
shared/static/wasm/sx/boot.sx
View File

@@ -55,6 +55,8 @@
(dom-append-to-head el))))) (dom-append-to-head el)))))
els)))) els))))
(define *hydrating* false)
(define (define
sx-mount sx-mount
:effects (mutation io) :effects (mutation io)
@@ -329,9 +331,14 @@
p p
(if (dict-has? kwargs p) (dict-get kwargs p) nil))) (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
(component-params comp)) (component-params comp))
(let (do
((body-dom (cek-try (fn () (with-island-scope (fn (disposable) (append! disposers disposable)) (fn () (render-to-dom (component-body comp) local nil)))) (fn (err) (log-warn (str "hydrate-island FAILED: " comp-name " — " err)) (let ((error-el (dom-create-element "div" nil))) (dom-set-attr error-el "class" "sx-island-error") (dom-set-attr error-el "style" "padding:8px;margin:4px 0;border:1px solid #ef4444;border-radius:4px;background:#fef2f2;color:#b91c1c;font-family:monospace;font-size:12px;white-space:pre-wrap") (dom-set-text-content error-el (str "Island error: " comp-name "\n" err)) error-el))))) (hydrate-start! el)
(host-call el "replaceChildren" body-dom) (log-info " hydrate-start done")
(with-island-scope
(fn (disposable) (append! disposers disposable))
(fn () (render-to-dom (component-body comp) local nil)))
(log-info " render-to-dom done")
(hydrate-stop!)
(dom-set-data el "sx-disposers" disposers) (dom-set-data el "sx-disposers" disposers)
(set-timeout (fn () (process-elements el)) 0) (set-timeout (fn () (process-elements el)) 0)
(log-info (log-info

4
shared/static/wasm/sx/boot.sxbc
View File

File diff suppressed because one or more lines are too long

177
web/adapter-dom.sx
View File

@@ -1,16 +1,48 @@
(import (sx dom)) (import (sx dom))
(import (sx render)) (import (sx render))
(define-library (web adapter-dom) (define-library
(export SVG_NS MATH_NS island-scope? contains-deref? dom-on render-to-dom render-dom-list render-dom-element render-dom-component render-dom-fragment render-dom-raw render-dom-unknown-component RENDER_DOM_FORMS render-dom-form? dispatch-render-form render-lambda-dom render-dom-island render-dom-lake render-dom-marsh reactive-text reactive-attr reactive-spread reactive-fragment render-list-item extract-key reactive-list bind-input *use-cek-reactive* enable-cek-reactive! cek-reactive-text cek-reactive-attr render-dom-portal render-dom-error-boundary) (web adapter-dom)
(export
SVG_NS
MATH_NS
island-scope?
contains-deref?
dom-on
render-to-dom
render-dom-list
render-dom-element
render-dom-component
render-dom-fragment
render-dom-raw
render-dom-unknown-component
RENDER_DOM_FORMS
render-dom-form?
dispatch-render-form
render-lambda-dom
render-dom-island
render-dom-lake
render-dom-marsh
reactive-text
reactive-attr
reactive-spread
reactive-fragment
render-list-item
extract-key
reactive-list
bind-input
*use-cek-reactive*
enable-cek-reactive!
cek-reactive-text
cek-reactive-attr
render-dom-portal
render-dom-error-boundary)
(begin (begin
(define SVG_NS "http://www.w3.org/2000/svg") (define SVG_NS "http://www.w3.org/2000/svg")
(define MATH_NS "http://www.w3.org/1998/Math/MathML") (define MATH_NS "http://www.w3.org/1998/Math/MathML")
(define
(define island-scope? (fn () (not (nil? (scope-peek "sx-island-scope"))))) island-scope?
(fn () (not (nil? (scope-peek "sx-island-scope")))))
(begin (begin
(define *memo-cache* (dict)) (define *memo-cache* (dict))
(define *cyst-counter* 0) (define *cyst-counter* 0)
@@ -20,7 +52,6 @@
() ()
(set! *cyst-counter* (+ *cyst-counter* 1)) (set! *cyst-counter* (+ *cyst-counter* 1))
(str "sx-cyst-" *cyst-counter*)))) (str "sx-cyst-" *cyst-counter*))))
(define (define
contains-deref? contains-deref?
(fn (fn
@@ -37,7 +68,6 @@
(= (symbol-name (first expr)) "deref")) (= (symbol-name (first expr)) "deref"))
true true
(some contains-deref? expr)))))) (some contains-deref? expr))))))
(define (define
dom-on dom-on
:effects (io) :effects (io)
@@ -59,7 +89,6 @@
(trampoline (call-lambda handler (list e))) (trampoline (call-lambda handler (list e)))
(run-post-render-hooks))) (run-post-render-hooks)))
handler)))) handler))))
(define (define
render-to-dom render-to-dom
:effects (render) :effects (render)
@@ -75,9 +104,15 @@
"raw-html" "raw-html"
(dom-parse-html (raw-html-content expr)) (dom-parse-html (raw-html-content expr))
"string" "string"
(create-text-node expr) (if
*hydrating*
(or (hydrate-next-text!) (create-text-node expr))
(create-text-node expr))
"number" "number"
(create-text-node (str expr)) (if
*hydrating*
(or (hydrate-next-text!) (create-text-node (str expr)))
(create-text-node (str expr)))
"symbol" "symbol"
(render-to-dom (trampoline (eval-expr expr env)) env ns) (render-to-dom (trampoline (eval-expr expr env)) env ns)
"keyword" "keyword"
@@ -101,7 +136,6 @@
(reactive-text expr) (reactive-text expr)
(create-text-node (str (deref expr)))) (create-text-node (str (deref expr))))
(create-text-node (str expr)))))) (create-text-node (str expr))))))
(define (define
render-dom-list render-dom-list
:effects (render) :effects (render)
@@ -136,7 +170,10 @@
(render-dom-element name args env ns) (render-dom-element name args env ns)
(dispatch-render-form name expr env ns)) (dispatch-render-form name expr env ns))
(and (env-has? env name) (macro? (env-get env name))) (and (env-has? env name) (macro? (env-get env name)))
(render-to-dom (expand-macro (env-get env name) args env) env ns) (render-to-dom
(expand-macro (env-get env name) args env)
env
ns)
(contains? HTML_TAGS name) (contains? HTML_TAGS name)
(render-dom-element name args env ns) (render-dom-element name args env ns)
(and (and
@@ -156,7 +193,12 @@
((skip (get state "skip"))) ((skip (get state "skip")))
(if (if
skip skip
(assoc state "skip" false "i" (inc (get state "i"))) (assoc
state
"skip"
false
"i"
(inc (get state "i")))
(if (if
(and (and
(= (type-of arg) "keyword") (= (type-of arg) "keyword")
@@ -178,7 +220,10 @@
(assoc state "i" (inc (get state "i"))))))) (assoc state "i" (inc (get state "i")))))))
(dict "i" 0 "skip" false) (dict "i" 0 "skip" false)
args) args)
(dom-set-attr marker "data-sx-island" (component-name island)) (dom-set-attr
marker
"data-sx-island"
(component-name island))
(when (when
(not (empty-dict? kw-state)) (not (empty-dict? kw-state))
(dom-set-attr (dom-set-attr
@@ -224,15 +269,21 @@
(when (not (spread? result)) (dom-append frag result)))) (when (not (spread? result)) (dom-append frag result))))
expr) expr)
frag))))) frag)))))
(define (define
render-dom-element render-dom-element
:effects (render) :effects (render)
(fn (fn
((tag :as string) (args :as list) (env :as dict) (ns :as string)) ((tag :as string) (args :as list) (env :as dict) (ns :as string))
(let (let
((new-ns (cond (= tag "svg") SVG_NS (= tag "math") MATH_NS :else ns)) ((new-ns (if (= tag "svg") SVG_NS (if (= tag "math") MATH_NS ns)))
(el (dom-create-element tag new-ns))) (el
(if
*hydrating*
(let
((existing (hydrate-next-element!)))
(when existing (hydrate-push! existing))
(or existing (dom-create-element tag new-ns)))
(dom-create-element tag new-ns))))
(scope-push! "element-attrs" nil) (scope-push! "element-attrs" nil)
(reduce (reduce
(fn (fn
@@ -296,7 +347,7 @@
(fn () (render-to-dom arg env new-ns))) (fn () (render-to-dom arg env new-ns)))
(spread? child) (spread? child)
nil nil
:else (dom-append el child)))) :else (when (not *hydrating*) (dom-append el child)))))
(assoc state "i" (inc (get state "i")))))))) (assoc state "i" (inc (get state "i"))))))))
(dict "i" 0 "skip" false) (dict "i" 0 "skip" false)
args) args)
@@ -334,13 +385,15 @@
(keys spread-dict))) (keys spread-dict)))
(scope-emitted "element-attrs")) (scope-emitted "element-attrs"))
(scope-pop! "element-attrs") (scope-pop! "element-attrs")
el))) (do (when *hydrating* (hydrate-pop!)) el))))
(define (define
render-dom-component render-dom-component
:effects (render) :effects (render)
(fn (fn
((comp :as component) (args :as list) (env :as dict) (ns :as string)) ((comp :as component)
(args :as list)
(env :as dict)
(ns :as string))
(let (let
((kwargs (dict)) (children (list))) ((kwargs (dict)) (children (list)))
(reduce (reduce
@@ -389,7 +442,6 @@
children) children)
(env-bind! local "children" child-frag))) (env-bind! local "children" child-frag)))
(render-to-dom (component-body comp) local ns))))) (render-to-dom (component-body comp) local ns)))))
(define (define
render-dom-fragment render-dom-fragment
:effects (render) :effects (render)
@@ -405,7 +457,6 @@
(when (not (spread? result)) (dom-append frag result)))) (when (not (spread? result)) (dom-append frag result))))
args) args)
frag))) frag)))
(define (define
render-dom-raw render-dom-raw
:effects (render) :effects (render)
@@ -427,12 +478,10 @@
(dom-append frag (create-text-node (str val)))))) (dom-append frag (create-text-node (str val))))))
args) args)
frag))) frag)))
(define (define
render-dom-unknown-component render-dom-unknown-component
:effects (render) :effects (render)
(fn ((name :as string)) (error (str "Unknown component: " name)))) (fn ((name :as string)) (error (str "Unknown component: " name))))
(define (define
RENDER_DOM_FORMS RENDER_DOM_FORMS
(list (list
@@ -459,12 +508,10 @@
"scope" "scope"
"provide" "provide"
"cyst")) "cyst"))
(define (define
render-dom-form? render-dom-form?
:effects () :effects ()
(fn ((name :as string)) (contains? RENDER_DOM_FORMS name))) (fn ((name :as string)) (contains? RENDER_DOM_FORMS name)))
(define (define
dispatch-render-form dispatch-render-form
:effects (render) :effects (render)
@@ -555,7 +602,9 @@
(for-each (for-each
(fn (fn
(i) (i)
(dom-append frag (render-to-dom (nth expr i) env ns))) (dom-append
frag
(render-to-dom (nth expr i) env ns)))
(range 2 (len expr))) (range 2 (len expr)))
(set! current-nodes (dom-child-nodes frag)) (set! current-nodes (dom-child-nodes frag))
(set! initial-result frag)))))) (set! initial-result frag))))))
@@ -670,7 +719,9 @@
bindings) bindings)
(when (when
(> (len body) 1) (> (len body) 1)
(for-each (fn (e) (trampoline (eval-expr e local))) (init body))) (for-each
(fn (e) (trampoline (eval-expr e local)))
(init body)))
(render-to-dom (last body) local ns)) (render-to-dom (last body) local ns))
(or (= name "begin") (= name "do")) (or (= name "begin") (= name "do"))
(if (if
@@ -771,7 +822,9 @@
(= (type-of (first rest-args)) "keyword") (= (type-of (first rest-args)) "keyword")
(= (keyword-name (first rest-args)) "value")) (= (keyword-name (first rest-args)) "value"))
(do (do
(set! scope-val (trampoline (eval-expr (nth rest-args 1) env))) (set!
scope-val
(trampoline (eval-expr (nth rest-args 1) env)))
(set! body-exprs (slice rest-args 2))) (set! body-exprs (slice rest-args 2)))
(set! body-exprs rest-args)) (set! body-exprs rest-args))
(scope-push! scope-name scope-val) (scope-push! scope-name scope-val)
@@ -787,7 +840,9 @@
(frag (create-fragment))) (frag (create-fragment)))
(scope-push! prov-name prov-val) (scope-push! prov-name prov-val)
(for-each (for-each
(fn (i) (dom-append frag (render-to-dom (nth expr i) env ns))) (fn
(i)
(dom-append frag (render-to-dom (nth expr i) env ns)))
(range 3 (len expr))) (range 3 (len expr)))
(scope-pop! prov-name) (scope-pop! prov-name)
frag) frag)
@@ -817,7 +872,6 @@
(dict-set! *memo-cache* cyst-key container) (dict-set! *memo-cache* cyst-key container)
container)))) container))))
:else (render-to-dom (trampoline (eval-expr expr env)) env ns)))) :else (render-to-dom (trampoline (eval-expr expr env)) env ns))))
(define (define
render-lambda-dom render-lambda-dom
:effects (render) :effects (render)
@@ -829,12 +883,14 @@
(fn (i p) (env-bind! local p (nth args i))) (fn (i p) (env-bind! local p (nth args i)))
(lambda-params f)) (lambda-params f))
(render-to-dom (lambda-body f) local ns)))) (render-to-dom (lambda-body f) local ns))))
(define (define
render-dom-island render-dom-island
:effects (render mutation) :effects (render mutation)
(fn (fn
((island :as island) (args :as list) (env :as dict) (ns :as string)) ((island :as island)
(args :as list)
(env :as dict)
(ns :as string))
(let (let
((kwargs (dict)) (children (list))) ((kwargs (dict)) (children (list)))
(reduce (reduce
@@ -878,19 +934,22 @@
children) children)
(env-bind! local "children" child-frag))) (env-bind! local "children" child-frag)))
(let (let
((container (dom-create-element "span" nil)) (disposers (list))) ((container (dom-create-element "span" nil))
(disposers (list)))
(begin (begin
(dom-set-attr container "data-sx-island" island-name) (dom-set-attr container "data-sx-island" island-name)
(when (when
(not (empty-dict? kwargs)) (not (empty-dict? kwargs))
(dom-set-attr container "data-sx-state" (sx-serialize kwargs)))) (dom-set-attr
container
"data-sx-state"
(sx-serialize kwargs))))
(mark-processed! container "island-hydrated") (mark-processed! container "island-hydrated")
(let (let
((body-dom (with-island-scope (fn (disposable) (append! disposers disposable)) (fn () (render-to-dom (component-body island) local ns))))) ((body-dom (with-island-scope (fn (disposable) (append! disposers disposable)) (fn () (render-to-dom (component-body island) local ns)))))
(dom-append container body-dom) (dom-append container body-dom)
(dom-set-data container "sx-disposers" disposers) (dom-set-data container "sx-disposers" disposers)
container)))))) container))))))
(define (define
render-dom-lake render-dom-lake
:effects (render) :effects (render)
@@ -933,7 +992,6 @@
(fn (c) (dom-append el (render-to-dom c env ns))) (fn (c) (dom-append el (render-to-dom c env ns)))
children) children)
el)))) el))))
(define (define
render-dom-marsh render-dom-marsh
:effects (render) :effects (render)
@@ -985,17 +1043,15 @@
(fn (c) (dom-append el (render-to-dom c env ns))) (fn (c) (dom-append el (render-to-dom c env ns)))
children) children)
el)))) el))))
(define (define
reactive-text reactive-text
:effects (render mutation) :effects (render mutation)
(fn (fn
(sig) (sig)
(let (let
((node (create-text-node (str (deref sig))))) ((node (if *hydrating* (or (hydrate-next-text!) (create-text-node (str (deref sig)))) (create-text-node (str (deref sig))))))
(effect (fn () (dom-set-text-content node (str (deref sig))))) (effect (fn () (dom-set-text-content node (str (deref sig)))))
node))) node)))
(define (define
reactive-attr reactive-attr
:effects (render mutation) :effects (render mutation)
@@ -1019,7 +1075,6 @@
(= val true) (= val true)
(dom-set-attr el attr-name "") (dom-set-attr el attr-name "")
:else (dom-set-attr el attr-name (str val))))))))) :else (dom-set-attr el attr-name (str val)))))))))
(define (define
reactive-spread reactive-spread
:effects (render mutation) :effects (render mutation)
@@ -1044,7 +1099,9 @@
(filter (fn (c) (not (= c ""))) (split current " "))) (filter (fn (c) (not (= c ""))) (split current " ")))
(kept (kept
(filter (filter
(fn (c) (not (some (fn (pc) (= pc c)) prev-classes))) (fn
(c)
(not (some (fn (pc) (= pc c)) prev-classes)))
tokens))) tokens)))
(if (if
(empty? kept) (empty? kept)
@@ -1059,7 +1116,9 @@
((attrs (spread-attrs result)) ((attrs (spread-attrs result))
(cls-str (or (dict-get attrs "class") "")) (cls-str (or (dict-get attrs "class") ""))
(new-classes (new-classes
(filter (fn (c) (not (= c ""))) (split cls-str " "))) (filter
(fn (c) (not (= c "")))
(split cls-str " ")))
(extra-keys (extra-keys
(filter (fn (k) (not (= k "class"))) (keys attrs)))) (filter (fn (k) (not (= k "class"))) (keys attrs))))
(set! prev-classes new-classes) (set! prev-classes new-classes)
@@ -1079,8 +1138,9 @@
(fn (k) (dom-set-attr el k (str (dict-get attrs k)))) (fn (k) (dom-set-attr el k (str (dict-get attrs k))))
extra-keys) extra-keys)
(run-post-render-hooks)) (run-post-render-hooks))
(do (set! prev-classes (list)) (set! prev-extra-keys (list)))))))))) (do
(set! prev-classes (list))
(set! prev-extra-keys (list))))))))))
(define (define
reactive-fragment reactive-fragment
:effects (render mutation) :effects (render mutation)
@@ -1090,7 +1150,8 @@
(env :as dict) (env :as dict)
(ns :as string)) (ns :as string))
(let (let
((marker (create-comment "island-fragment")) (current-nodes (list))) ((marker (create-comment "island-fragment"))
(current-nodes (list)))
(effect (effect
(fn (fn
() ()
@@ -1103,7 +1164,6 @@
(set! current-nodes (dom-child-nodes frag)) (set! current-nodes (dom-child-nodes frag))
(dom-insert-after marker frag))))) (dom-insert-after marker frag)))))
marker))) marker)))
(define (define
render-list-item render-list-item
:effects (render) :effects (render)
@@ -1113,7 +1173,6 @@
(lambda? map-fn) (lambda? map-fn)
(render-lambda-dom map-fn (list item) env ns) (render-lambda-dom map-fn (list item) env ns)
(render-to-dom (apply map-fn (list item)) env ns)))) (render-to-dom (apply map-fn (list item)) env ns))))
(define (define
extract-key extract-key
:effects (render) :effects (render)
@@ -1127,7 +1186,6 @@
(let (let
((dk (dom-get-data node "key"))) ((dk (dom-get-data node "key")))
(if dk (str dk) (str "__idx_" index))))))) (if dk (str dk) (str "__idx_" index)))))))
(define (define
reactive-list reactive-list
:effects (render mutation) :effects (render mutation)
@@ -1212,7 +1270,6 @@
(dom-append container rendered))) (dom-append container rendered)))
items))))) items)))))
container))) container)))
(define (define
bind-input bind-input
:effects (render mutation) :effects (render mutation)
@@ -1220,7 +1277,8 @@
(el (sig :as signal)) (el (sig :as signal))
(let (let
((input-type (lower (or (dom-get-attr el "type") ""))) ((input-type (lower (or (dom-get-attr el "type") "")))
(is-checkbox (or (= input-type "checkbox") (= input-type "radio")))) (is-checkbox
(or (= input-type "checkbox") (= input-type "radio"))))
(if (if
is-checkbox is-checkbox
(dom-set-prop el "checked" (deref sig)) (dom-set-prop el "checked" (deref sig))
@@ -1245,11 +1303,8 @@
is-checkbox is-checkbox
(reset! sig (dom-get-prop el "checked")) (reset! sig (dom-get-prop el "checked"))
(reset! sig (dom-get-prop el "value")))))))) (reset! sig (dom-get-prop el "value"))))))))
(define *use-cek-reactive* true) (define *use-cek-reactive* true)
(define enable-cek-reactive! (fn () (set! *use-cek-reactive* true))) (define enable-cek-reactive! (fn () (set! *use-cek-reactive* true)))
(define (define
cek-reactive-text cek-reactive-text
:effects (render mutation) :effects (render mutation)
@@ -1262,7 +1317,6 @@
((initial (cek-run (make-cek-state expr env (list (make-reactive-reset-frame env update-fn true)))))) ((initial (cek-run (make-cek-state expr env (list (make-reactive-reset-frame env update-fn true))))))
(dom-set-text-content node (str initial)) (dom-set-text-content node (str initial))
node)))) node))))
(define (define
cek-reactive-attr cek-reactive-attr
:effects (render mutation) :effects (render mutation)
@@ -1278,7 +1332,6 @@
(let (let
((initial (cek-run (make-cek-state expr env (list (make-reactive-reset-frame env update-fn true)))))) ((initial (cek-run (make-cek-state expr env (list (make-reactive-reset-frame env update-fn true))))))
(cek-call update-fn (list initial)))))) (cek-call update-fn (list initial))))))
(define (define
render-dom-portal render-dom-portal
:effects (render) :effects (render)
@@ -1302,7 +1355,6 @@
(register-in-scope (register-in-scope
(fn () (for-each (fn (n) (dom-remove n)) portal-nodes)))) (fn () (for-each (fn (n) (dom-remove n)) portal-nodes))))
marker))))) marker)))))
(define (define
render-dom-error-boundary render-dom-error-boundary
:effects (render) :effects (render)
@@ -1342,10 +1394,7 @@
(let (let
((fallback-dom (if (nil? fallback-fn) (let ((el (dom-create-element "div" nil))) (dom-set-attr el "class" "sx-render-error") (dom-set-attr el "style" "color:red;font-size:0.875rem;padding:0.5rem;border:1px solid red;border-radius:0.25rem;margin:0.5rem 0;") (dom-set-text-content el (str "Render error: " err)) el) (if (lambda? fallback-fn) (render-lambda-dom fallback-fn (list err retry-fn) env ns) (render-to-dom (apply fallback-fn (list err retry-fn)) env ns))))) ((fallback-dom (if (nil? fallback-fn) (let ((el (dom-create-element "div" nil))) (dom-set-attr el "class" "sx-render-error") (dom-set-attr el "style" "color:red;font-size:0.875rem;padding:0.5rem;border:1px solid red;border-radius:0.25rem;margin:0.5rem 0;") (dom-set-text-content el (str "Render error: " err)) el) (if (lambda? fallback-fn) (render-lambda-dom fallback-fn (list err retry-fn) env ns) (render-to-dom (apply fallback-fn (list err retry-fn)) env ns)))))
(dom-append container fallback-dom))))))) (dom-append container fallback-dom)))))))
container))) container)))))
))
;; Re-export to global env ;; Re-export to global env
(import (web adapter-dom)) (import (web adapter-dom))

13
web/boot.sx
View File

@@ -55,6 +55,8 @@
(dom-append-to-head el))))) (dom-append-to-head el)))))
els)))) els))))
(define *hydrating* false)
(define (define
sx-mount sx-mount
:effects (mutation io) :effects (mutation io)
@@ -329,9 +331,14 @@
p p
(if (dict-has? kwargs p) (dict-get kwargs p) nil))) (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
(component-params comp)) (component-params comp))
(let (do
((body-dom (cek-try (fn () (with-island-scope (fn (disposable) (append! disposers disposable)) (fn () (render-to-dom (component-body comp) local nil)))) (fn (err) (log-warn (str "hydrate-island FAILED: " comp-name " — " err)) (let ((error-el (dom-create-element "div" nil))) (dom-set-attr error-el "class" "sx-island-error") (dom-set-attr error-el "style" "padding:8px;margin:4px 0;border:1px solid #ef4444;border-radius:4px;background:#fef2f2;color:#b91c1c;font-family:monospace;font-size:12px;white-space:pre-wrap") (dom-set-text-content error-el (str "Island error: " comp-name "\n" err)) error-el))))) (hydrate-start! el)
(host-call el "replaceChildren" body-dom) (log-info " hydrate-start done")
(with-island-scope
(fn (disposable) (append! disposers disposable))
(fn () (render-to-dom (component-body comp) local nil)))
(log-info " render-to-dom done")
(hydrate-stop!)
(dom-set-data el "sx-disposers" disposers) (dom-set-data el "sx-disposers" disposers)
(set-timeout (fn () (process-elements el)) 0) (set-timeout (fn () (process-elements el)) 0)
(log-info (log-info