coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
efc7e340daae77f29f69ace5a2b04434f507e694
rose-ash/shared/sx/ref/adapter-dom.sx
giles 189a0258d9 Fix reactive islands client-side navigation and hydration 
Three bugs prevented islands from working during SX wire navigation:

1. components_for_request() only bundled Component and Macro defs, not
   Island defs — client never received defisland definitions during
   navigation (components_for_page for initial HTML shell was correct).

2. hydrate-island used morph-children which can't transfer addEventListener
   event handlers from freshly rendered DOM to existing nodes. Changed to
   clear+append so reactive DOM with live signal subscriptions is inserted
   directly.

3. asyncRenderToDom (client-side async page eval) checked _component but
   not _island on ~-prefixed names — islands fell through to generic eval
   which failed. Now delegates to renderDomIsland.

4. setInterval_/setTimeout_ passed SX Lambda objects directly to native
   timers. JS coerced them to "[object Object]" and tried to eval as code,
   causing "missing ] after element list". Added _wrapSxFn to convert SX
   lambdas to JS functions before passing to timers.

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
2026-03-08 15:18:45 +00:00

635 lines
24 KiB
Plaintext
Raw Blame History

;; ==========================================================================
;; adapter-dom.sx — DOM rendering adapter
;;
;; Renders SX expressions to live DOM nodes. Browser-only.
;; Mirrors the render-to-html adapter but produces Element/Text/Fragment
;; nodes instead of HTML strings.
;;
;; Depends on:
;; render.sx — HTML_TAGS, VOID_ELEMENTS, BOOLEAN_ATTRS, definition-form?
;; eval.sx — eval-expr, trampoline, call-component, expand-macro
;; ==========================================================================
(define SVG_NS "http://www.w3.org/2000/svg")
(define MATH_NS "http://www.w3.org/1998/Math/MathML")
;; --------------------------------------------------------------------------
;; render-to-dom — main entry point
;; --------------------------------------------------------------------------
(define render-to-dom
(fn (expr env ns)
(case (type-of expr)
;; nil / boolean false / boolean true → empty fragment
"nil" (create-fragment)
"boolean" (create-fragment)
;; Pre-rendered raw HTML → parse into fragment
"raw-html" (dom-parse-html (raw-html-content expr))
;; String → text node
"string" (create-text-node expr)
;; Number → text node
"number" (create-text-node (str expr))
;; Symbol → evaluate then render
"symbol" (render-to-dom (trampoline (eval-expr expr env)) env ns)
;; Keyword → text
"keyword" (create-text-node (keyword-name expr))
;; Pre-rendered DOM node → pass through
"dom-node" expr
;; Dict → empty
"dict" (create-fragment)
;; List → dispatch
"list"
(if (empty? expr)
(create-fragment)
(render-dom-list expr env ns))
;; Fallback
:else (create-text-node (str expr)))))
;; --------------------------------------------------------------------------
;; render-dom-list — dispatch on list head
;; --------------------------------------------------------------------------
(define render-dom-list
(fn (expr env ns)
(let ((head (first expr)))
(cond
;; Symbol head — dispatch on name
(= (type-of head) "symbol")
(let ((name (symbol-name head))
(args (rest expr)))
(cond
;; raw! → insert unescaped HTML
(= name "raw!")
(render-dom-raw args env)
;; <> → fragment
(= name "<>")
(render-dom-fragment args env ns)
;; html: prefix → force element rendering
(starts-with? name "html:")
(render-dom-element (slice name 5) args env ns)
;; Render-aware special forms
(render-dom-form? name)
(if (and (contains? HTML_TAGS name)
(or (and (> (len args) 0)
(= (type-of (first args)) "keyword"))
ns))
;; Ambiguous: tag name that's also a form — treat as tag
;; when keyword arg or namespace present
(render-dom-element name args env ns)
(dispatch-render-form name expr env ns))
;; Macro expansion
(and (env-has? env name) (macro? (env-get env name)))
(render-to-dom
(expand-macro (env-get env name) args env)
env ns)
;; HTML tag
(contains? HTML_TAGS name)
(render-dom-element name args env ns)
;; Island (~name) — reactive component
(and (starts-with? name "~")
(env-has? env name)
(island? (env-get env name)))
(render-dom-island (env-get env name) args env ns)
;; Component (~name)
(starts-with? name "~")
(let ((comp (env-get env name)))
(if (component? comp)
(render-dom-component comp args env ns)
(render-dom-unknown-component name)))
;; Custom element (hyphenated with keyword attrs)
(and (> (index-of name "-") 0)
(> (len args) 0)
(= (type-of (first args)) "keyword"))
(render-dom-element name args env ns)
;; Inside SVG/MathML namespace — treat as element
ns
(render-dom-element name args env ns)
;; deref in island scope → reactive text node
(and (= name "deref") *island-scope*)
(let ((sig-or-val (trampoline (eval-expr (first args) env))))
(if (signal? sig-or-val)
(reactive-text sig-or-val)
(create-text-node (str (deref sig-or-val)))))
;; Fallback — evaluate then render
:else
(render-to-dom (trampoline (eval-expr expr env)) env ns)))
;; Lambda or list head → evaluate
(or (lambda? head) (= (type-of head) "list"))
(render-to-dom (trampoline (eval-expr expr env)) env ns)
;; Data list
:else
(let ((frag (create-fragment)))
(for-each (fn (x) (dom-append frag (render-to-dom x env ns))) expr)
frag)))))
;; --------------------------------------------------------------------------
;; render-dom-element — create a DOM element with attrs and children
;; --------------------------------------------------------------------------
(define render-dom-element
(fn (tag args env ns)
;; Detect namespace from tag
(let ((new-ns (cond (= tag "svg") SVG_NS
(= tag "math") MATH_NS
:else ns))
(el (dom-create-element tag new-ns)))
;; Process args: keywords → attrs, others → children
(reduce
(fn (state arg)
(let ((skip (get state "skip")))
(if skip
(assoc state "skip" false "i" (inc (get state "i")))
(if (and (= (type-of arg) "keyword")
(< (inc (get state "i")) (len args)))
;; Keyword arg → attribute
(let ((attr-name (keyword-name arg))
(attr-val (trampoline
(eval-expr
(nth args (inc (get state "i")))
env))))
(cond
;; nil or false → skip
(or (nil? attr-val) (= attr-val false))
nil
;; Event handler: on-click, on-submit, on-input, etc.
;; Value must be callable (lambda/function)
(and (starts-with? attr-name "on-")
(callable? attr-val))
(dom-listen el (slice attr-name 3) attr-val)
;; Boolean attr
(contains? BOOLEAN_ATTRS attr-name)
(when attr-val (dom-set-attr el attr-name ""))
;; true → empty attr
(= attr-val true)
(dom-set-attr el attr-name "")
;; Normal attr
:else
(dom-set-attr el attr-name (str attr-val)))
(assoc state "skip" true "i" (inc (get state "i"))))
;; Positional arg → child
(do
(when (not (contains? VOID_ELEMENTS tag))
(dom-append el (render-to-dom arg env new-ns)))
(assoc state "i" (inc (get state "i"))))))))
(dict "i" 0 "skip" false)
args)
el)))
;; --------------------------------------------------------------------------
;; render-dom-component — expand and render a component
;; --------------------------------------------------------------------------
(define render-dom-component
(fn (comp args env ns)
;; Parse kwargs and children, bind into component env, render body.
(let ((kwargs (dict))
(children (list)))
;; Separate keyword args from positional children
(reduce
(fn (state arg)
(let ((skip (get state "skip")))
(if skip
(assoc state "skip" false "i" (inc (get state "i")))
(if (and (= (type-of arg) "keyword")
(< (inc (get state "i")) (len args)))
;; Keyword arg — evaluate in caller's env
(let ((val (trampoline
(eval-expr (nth args (inc (get state "i"))) env))))
(dict-set! kwargs (keyword-name arg) val)
(assoc state "skip" true "i" (inc (get state "i"))))
(do
(append! children arg)
(assoc state "i" (inc (get state "i"))))))))
(dict "i" 0 "skip" false)
args)
;; Build component env: closure + caller env + params
(let ((local (env-merge (component-closure comp) env)))
;; Bind params from kwargs
(for-each
(fn (p)
(env-set! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
(component-params comp))
;; If component accepts children, pre-render them to a fragment
(when (component-has-children? comp)
(let ((child-frag (create-fragment)))
(for-each
(fn (c) (dom-append child-frag (render-to-dom c env ns)))
children)
(env-set! local "children" child-frag)))
(render-to-dom (component-body comp) local ns)))))
;; --------------------------------------------------------------------------
;; render-dom-fragment — render children into a DocumentFragment
;; --------------------------------------------------------------------------
(define render-dom-fragment
(fn (args env ns)
(let ((frag (create-fragment)))
(for-each
(fn (x) (dom-append frag (render-to-dom x env ns)))
args)
frag)))
;; --------------------------------------------------------------------------
;; render-dom-raw — insert unescaped content
;; --------------------------------------------------------------------------
(define render-dom-raw
(fn (args env)
(let ((frag (create-fragment)))
(for-each
(fn (arg)
(let ((val (trampoline (eval-expr arg env))))
(cond
(= (type-of val) "string")
(dom-append frag (dom-parse-html val))
(= (type-of val) "dom-node")
(dom-append frag (dom-clone val))
(not (nil? val))
(dom-append frag (create-text-node (str val))))))
args)
frag)))
;; --------------------------------------------------------------------------
;; render-dom-unknown-component — visible warning element
;; --------------------------------------------------------------------------
(define render-dom-unknown-component
(fn (name)
(error (str "Unknown component: " name))))
;; --------------------------------------------------------------------------
;; Render-aware special forms for DOM output
;; --------------------------------------------------------------------------
;; These forms need special handling in DOM rendering because they
;; produce DOM nodes rather than evaluated values.
(define RENDER_DOM_FORMS
(list "if" "when" "cond" "case" "let" "let*" "begin" "do"
"define" "defcomp" "defisland" "defmacro" "defstyle" "defhandler"
"map" "map-indexed" "filter" "for-each"))
(define render-dom-form?
(fn (name)
(contains? RENDER_DOM_FORMS name)))
(define dispatch-render-form
(fn (name expr env ns)
(cond
;; if
(= name "if")
(let ((cond-val (trampoline (eval-expr (nth expr 1) env))))
(if cond-val
(render-to-dom (nth expr 2) env ns)
(if (> (len expr) 3)
(render-to-dom (nth expr 3) env ns)
(create-fragment))))
;; when
(= name "when")
(if (not (trampoline (eval-expr (nth expr 1) env)))
(create-fragment)
(let ((frag (create-fragment)))
(for-each
(fn (i)
(dom-append frag (render-to-dom (nth expr i) env ns)))
(range 2 (len expr)))
frag))
;; cond
(= name "cond")
(let ((branch (eval-cond (rest expr) env)))
(if branch
(render-to-dom branch env ns)
(create-fragment)))
;; case
(= name "case")
(render-to-dom (trampoline (eval-expr expr env)) env ns)
;; let / let*
(or (= name "let") (= name "let*"))
(let ((local (process-bindings (nth expr 1) env))
(frag (create-fragment)))
(for-each
(fn (i)
(dom-append frag (render-to-dom (nth expr i) local ns)))
(range 2 (len expr)))
frag)
;; begin / do
(or (= name "begin") (= name "do"))
(let ((frag (create-fragment)))
(for-each
(fn (i)
(dom-append frag (render-to-dom (nth expr i) env ns)))
(range 1 (len expr)))
frag)
;; Definition forms — eval for side effects
(definition-form? name)
(do (trampoline (eval-expr expr env)) (create-fragment))
;; map
(= name "map")
(let ((f (trampoline (eval-expr (nth expr 1) env)))
(coll (trampoline (eval-expr (nth expr 2) env)))
(frag (create-fragment)))
(for-each
(fn (item)
(let ((val (if (lambda? f)
(render-lambda-dom f (list item) env ns)
(render-to-dom (apply f (list item)) env ns))))
(dom-append frag val)))
coll)
frag)
;; map-indexed
(= name "map-indexed")
(let ((f (trampoline (eval-expr (nth expr 1) env)))
(coll (trampoline (eval-expr (nth expr 2) env)))
(frag (create-fragment)))
(for-each-indexed
(fn (i item)
(let ((val (if (lambda? f)
(render-lambda-dom f (list i item) env ns)
(render-to-dom (apply f (list i item)) env ns))))
(dom-append frag val)))
coll)
frag)
;; filter — evaluate fully then render
(= name "filter")
(render-to-dom (trampoline (eval-expr expr env)) env ns)
;; for-each (render variant)
(= name "for-each")
(let ((f (trampoline (eval-expr (nth expr 1) env)))
(coll (trampoline (eval-expr (nth expr 2) env)))
(frag (create-fragment)))
(for-each
(fn (item)
(let ((val (if (lambda? f)
(render-lambda-dom f (list item) env ns)
(render-to-dom (apply f (list item)) env ns))))
(dom-append frag val)))
coll)
frag)
;; Fallback
:else
(render-to-dom (trampoline (eval-expr expr env)) env ns))))
;; --------------------------------------------------------------------------
;; render-lambda-dom — render a lambda body in DOM context
;; --------------------------------------------------------------------------
(define render-lambda-dom
(fn (f args env ns)
;; Bind lambda params and render body as DOM
(let ((local (env-merge (lambda-closure f) env)))
(for-each-indexed
(fn (i p)
(env-set! local p (nth args i)))
(lambda-params f))
(render-to-dom (lambda-body f) local ns))))
;; --------------------------------------------------------------------------
;; render-dom-island — render a reactive island
;; --------------------------------------------------------------------------
;;
;; Islands render like components but wrapped in a reactive context.
;; The island container element gets data-sx-island and data-sx-state
;; attributes for identification and hydration.
;;
;; Inside the island body, deref calls create reactive DOM subscriptions:
;; - Text bindings: (deref sig) in text position → reactive text node
;; - Attribute bindings: (deref sig) in attr → reactive attribute
;; - Conditional fragments: (when (deref sig) ...) → reactive show/hide
(define render-dom-island
(fn (island args env ns)
;; Parse kwargs and children (same as component)
(let ((kwargs (dict))
(children (list)))
(reduce
(fn (state arg)
(let ((skip (get state "skip")))
(if skip
(assoc state "skip" false "i" (inc (get state "i")))
(if (and (= (type-of arg) "keyword")
(< (inc (get state "i")) (len args)))
(let ((val (trampoline
(eval-expr (nth args (inc (get state "i"))) env))))
(dict-set! kwargs (keyword-name arg) val)
(assoc state "skip" true "i" (inc (get state "i"))))
(do
(append! children arg)
(assoc state "i" (inc (get state "i"))))))))
(dict "i" 0 "skip" false)
args)
;; Build island env: closure + caller env + params
(let ((local (env-merge (component-closure island) env))
(island-name (component-name island)))
;; Bind params from kwargs
(for-each
(fn (p)
(env-set! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
(component-params island))
;; If island accepts children, pre-render them to a fragment
(when (component-has-children? island)
(let ((child-frag (create-fragment)))
(for-each
(fn (c) (dom-append child-frag (render-to-dom c env ns)))
children)
(env-set! local "children" child-frag)))
;; Create the island container element
(let ((container (dom-create-element "div" nil))
(disposers (list)))
;; Mark as island
(dom-set-attr container "data-sx-island" island-name)
;; Render island body inside a scope that tracks disposers
(let ((body-dom
(with-island-scope
(fn (disposable) (append! disposers disposable))
(fn () (render-to-dom (component-body island) local ns)))))
(dom-append container body-dom)
;; Store disposers on the container for cleanup
(dom-set-data container "sx-disposers" disposers)
container))))))
;; --------------------------------------------------------------------------
;; Reactive DOM rendering helpers
;; --------------------------------------------------------------------------
;;
;; These functions create reactive bindings between signals and DOM nodes.
;; They are called by the platform's renderDOM when it detects deref
;; calls inside an island context.
;; reactive-text — create a text node bound to a signal
;; Used when (deref sig) appears in a text position inside an island.
(define reactive-text
(fn (sig)
(let ((node (create-text-node (str (deref sig)))))
(effect (fn ()
(dom-set-text-content node (str (deref sig)))))
node)))
;; reactive-attr — bind an element attribute to a signal expression
;; Used when an attribute value contains (deref sig) inside an island.
(define reactive-attr
(fn (el attr-name compute-fn)
(effect (fn ()
(let ((val (compute-fn)))
(cond
(or (nil? val) (= val false))
(dom-remove-attr el attr-name)
(= val true)
(dom-set-attr el attr-name "")
:else
(dom-set-attr el attr-name (str val))))))))
;; reactive-fragment — conditionally render a fragment based on a signal
;; Used for (when (deref sig) ...) or (if (deref sig) ...) inside an island.
(define reactive-fragment
(fn (test-fn render-fn env ns)
(let ((marker (create-comment "island-fragment"))
(current-nodes (list)))
(effect (fn ()
;; Remove previous nodes
(for-each (fn (n) (dom-remove n)) current-nodes)
(set! current-nodes (list))
;; If test passes, render and insert after marker
(when (test-fn)
(let ((frag (render-fn)))
(set! current-nodes (dom-child-nodes frag))
(dom-insert-after marker frag)))))
marker)))
;; reactive-list — render a keyed list bound to a signal
;; Used for (map fn (deref items)) inside an island.
(define reactive-list
(fn (map-fn items-sig env ns)
(let ((container (create-fragment))
(marker (create-comment "island-list")))
(dom-append container marker)
(effect (fn ()
;; Simple strategy: clear and re-render
;; Future: keyed reconciliation
(let ((parent (dom-parent marker)))
(when parent
;; Remove all nodes after marker until next sibling marker
(dom-remove-children-after marker)
;; Render new items
(let ((items (deref items-sig)))
(for-each
(fn (item)
(let ((rendered (if (lambda? map-fn)
(render-lambda-dom map-fn (list item) env ns)
(render-to-dom (apply map-fn (list item)) env ns))))
(dom-insert-after marker rendered)))
(reverse items)))))))
container)))
;; --------------------------------------------------------------------------
;; Platform interface — DOM adapter
;; --------------------------------------------------------------------------
;;
;; Element creation:
;; (dom-create-element tag ns) → Element (ns=nil for HTML, string for SVG/MathML)
;; (create-text-node s) → Text node
;; (create-fragment) → DocumentFragment
;; (create-comment s) → Comment node
;;
;; Tree mutation:
;; (dom-append parent child) → void (appendChild)
;; (dom-set-attr el name val) → void (setAttribute)
;; (dom-remove-attr el name) → void (removeAttribute)
;; (dom-get-attr el name) → string or nil (getAttribute)
;; (dom-set-text-content n s) → void (set textContent)
;; (dom-remove node) → void (remove from parent)
;; (dom-insert-after ref node) → void (insert node after ref)
;; (dom-parent node) → parent Element or nil
;; (dom-child-nodes frag) → list of child nodes
;; (dom-remove-children-after m)→ void (remove all siblings after marker)
;; (dom-set-data el key val) → void (store arbitrary data on element)
;; (dom-get-data el key) → any (retrieve data stored on element)
;;
;; Event handling:
;; (dom-listen el name handler) → remove-fn (addEventListener, returns remover)
;; (dom-dispatch el name detail)→ boolean (dispatch CustomEvent, bubbles: true)
;;
;; Content parsing:
;; (dom-parse-html s) → DocumentFragment from HTML string
;; (dom-clone node) → deep clone of a DOM node
;;
;; Type checking:
;; DOM nodes have type-of → "dom-node"
;;
;; From render.sx:
;; HTML_TAGS, VOID_ELEMENTS, BOOLEAN_ATTRS, definition-form?
;;
;; From eval.sx:
;; eval-expr, trampoline, expand-macro, process-bindings, eval-cond
;; env-has?, env-get, env-set!, env-merge
;; lambda?, component?, island?, macro?
;; lambda-closure, lambda-params, lambda-body
;; component-params, component-body, component-closure,
;; component-has-children?, component-name
;;
;; From signals.sx:
;; signal, deref, reset!, swap!, computed, effect, batch
;; signal?, with-island-scope
;;
;; Iteration:
;; (for-each-indexed fn coll) → call fn(index, item) for each element
;; --------------------------------------------------------------------------
Reference in New Issue View Git Blame Copy Permalink