;; ========================================================================== ;; 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 :effects [render] (fn (expr (env :as dict) (ns :as string)) (set-render-active! true) (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 ;; Spread → emit attrs to nearest element provider, pass through for reactive-spread "spread" (do (emit! "element-attrs" (spread-attrs expr)) expr) ;; Dict → empty "dict" (create-fragment) ;; List → dispatch "list" (if (empty? expr) (create-fragment) (render-dom-list expr env ns)) ;; Signal → reactive text in island scope, deref outside :else (if (signal? expr) (if (context "sx-island-scope" nil) (reactive-text expr) (create-text-node (str (deref expr)))) (create-text-node (str expr)))))) ;; -------------------------------------------------------------------------- ;; render-dom-list — dispatch on list head ;; -------------------------------------------------------------------------- (define render-dom-list :effects [render] (fn (expr (env :as dict) (ns :as string)) (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) ;; lake — server-morphable slot within an island (= name "lake") (render-dom-lake args env ns) ;; marsh — reactive server-morphable slot within an island (= name "marsh") (render-dom-marsh 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") (context "sx-island-scope" nil)) (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) (let ((result (render-to-dom x env ns))) (when (not (spread? result)) (dom-append frag result)))) expr) frag))))) ;; -------------------------------------------------------------------------- ;; render-dom-element — create a DOM element with attrs and children ;; -------------------------------------------------------------------------- (define render-dom-element :effects [render] (fn ((tag :as string) (args :as list) (env :as dict) (ns :as string)) ;; 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))) ;; Provide scope for spread emit! — deeply nested spreads emit here (scope-push! "element-attrs" nil) ;; 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-expr (nth args (inc (get state "i"))))) (cond ;; Event handler: evaluate eagerly, bind listener (starts-with? attr-name "on-") (let ((attr-val (trampoline (eval-expr attr-expr env)))) (when (callable? attr-val) (dom-listen el (slice attr-name 3) attr-val))) ;; Two-way input binding: :bind signal (= attr-name "bind") (let ((attr-val (trampoline (eval-expr attr-expr env)))) (when (signal? attr-val) (bind-input el attr-val))) ;; ref: set ref.current to this element (= attr-name "ref") (let ((attr-val (trampoline (eval-expr attr-expr env)))) (dict-set! attr-val "current" el)) ;; key: reconciliation hint, evaluate eagerly (not reactive) (= attr-name "key") (let ((attr-val (trampoline (eval-expr attr-expr env)))) (dom-set-attr el "key" (str attr-val))) ;; Inside island scope: reactive attribute binding. ;; The effect tracks signal deps automatically — if none ;; are deref'd, it fires once and never again (safe). (context "sx-island-scope" nil) (reactive-attr el attr-name (fn () (trampoline (eval-expr attr-expr env)))) ;; Static attribute (outside islands) :else (let ((attr-val (trampoline (eval-expr attr-expr env)))) (cond (or (nil? attr-val) (= attr-val false)) nil (contains? BOOLEAN_ATTRS attr-name) (when attr-val (dom-set-attr el attr-name "")) (= attr-val true) (dom-set-attr el attr-name "") :else (dom-set-attr el attr-name (str attr-val))))) (assoc state "skip" true "i" (inc (get state "i")))) ;; Positional arg → child (or spread → merge attrs onto element) (do (when (not (contains? VOID_ELEMENTS tag)) (let ((child (render-to-dom arg env new-ns))) (cond ;; Reactive spread: track signal deps, update attrs on change (and (spread? child) (context "sx-island-scope" nil)) (reactive-spread el (fn () (render-to-dom arg env new-ns))) ;; Static spread: already emitted via provide, skip (spread? child) nil ;; Normal child: append to element :else (dom-append el child)))) (assoc state "i" (inc (get state "i")))))))) (dict "i" 0 "skip" false) args) ;; Collect emitted spread attrs and merge onto DOM element (for-each (fn (spread-dict) (for-each (fn ((key :as string)) (let ((val (dict-get spread-dict key))) (if (= key "class") (let ((existing (dom-get-attr el "class"))) (dom-set-attr el "class" (if (and existing (not (= existing ""))) (str existing " " val) val))) (if (= key "style") (let ((existing (dom-get-attr el "style"))) (dom-set-attr el "style" (if (and existing (not (= existing ""))) (str existing ";" val) val))) (dom-set-attr el key (str val)))))) (keys spread-dict))) (emitted "element-attrs")) (scope-pop! "element-attrs") el))) ;; -------------------------------------------------------------------------- ;; render-dom-component — expand and render a component ;; -------------------------------------------------------------------------- (define render-dom-component :effects [render] (fn ((comp :as component) (args :as list) (env :as dict) (ns :as string)) ;; 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-bind! 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 ;; Spread values are filtered out (no parent element to merge onto) (when (component-has-children? comp) (let ((child-frag (create-fragment))) (for-each (fn (c) (let ((result (render-to-dom c env ns))) (when (not (spread? result)) (dom-append child-frag result)))) children) (env-bind! local "children" child-frag))) (render-to-dom (component-body comp) local ns))))) ;; -------------------------------------------------------------------------- ;; render-dom-fragment — render children into a DocumentFragment ;; -------------------------------------------------------------------------- (define render-dom-fragment :effects [render] (fn ((args :as list) (env :as dict) (ns :as string)) (let ((frag (create-fragment))) (for-each (fn (x) (let ((result (render-to-dom x env ns))) (when (not (spread? result)) (dom-append frag result)))) args) frag))) ;; -------------------------------------------------------------------------- ;; render-dom-raw — insert unescaped content ;; -------------------------------------------------------------------------- (define render-dom-raw :effects [render] (fn ((args :as list) (env :as dict)) (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 :effects [render] (fn ((name :as string)) (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" "map" "map-indexed" "filter" "for-each" "portal" "error-boundary" "scope" "provide")) (define render-dom-form? :effects [] (fn ((name :as string)) (contains? RENDER_DOM_FORMS name))) (define dispatch-render-form :effects [render] (fn ((name :as string) expr (env :as dict) (ns :as string)) (cond ;; if — reactive inside islands (re-renders when signal deps change) (= name "if") (if (context "sx-island-scope" nil) (let ((marker (create-comment "r-if")) (current-nodes (list)) (initial-result nil)) ;; Effect runs synchronously on first call, tracking signal deps. ;; On first run, store result in initial-result (marker has no parent yet). ;; On subsequent runs, swap DOM nodes after marker. (effect (fn () (let ((result (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)))))) (if (dom-parent marker) ;; Marker is in DOM — swap nodes (do (for-each (fn (n) (dom-remove n)) current-nodes) (set! current-nodes (if (dom-is-fragment? result) (dom-child-nodes result) (list result))) (dom-insert-after marker result)) ;; Marker not yet in DOM (first run) — just save result (set! initial-result result))))) ;; Spread pass-through: spreads aren't DOM nodes, can't live ;; in fragments. Return directly so parent element merges attrs. (if (spread? initial-result) initial-result (let ((frag (create-fragment))) (dom-append frag marker) (when initial-result (set! current-nodes (if (dom-is-fragment? initial-result) (dom-child-nodes initial-result) (list initial-result))) (dom-append frag initial-result)) frag))) ;; Static 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 — reactive inside islands (= name "when") (if (context "sx-island-scope" nil) (let ((marker (create-comment "r-when")) (current-nodes (list)) (initial-result nil)) (effect (fn () (if (dom-parent marker) ;; In DOM — swap nodes (do (for-each (fn (n) (dom-remove n)) current-nodes) (set! current-nodes (list)) (when (trampoline (eval-expr (nth expr 1) env)) (let ((frag (create-fragment))) (for-each (fn (i) (dom-append frag (render-to-dom (nth expr i) env ns))) (range 2 (len expr))) (set! current-nodes (dom-child-nodes frag)) (dom-insert-after marker frag)))) ;; First run — save result for fragment (when (trampoline (eval-expr (nth expr 1) env)) (let ((frag (create-fragment))) (for-each (fn (i) (dom-append frag (render-to-dom (nth expr i) env ns))) (range 2 (len expr))) (set! current-nodes (dom-child-nodes frag)) (set! initial-result frag)))))) ;; Spread pass-through (if (spread? initial-result) initial-result (let ((frag (create-fragment))) (dom-append frag marker) (when initial-result (dom-append frag initial-result)) frag))) ;; Static 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 — reactive inside islands (= name "cond") (if (context "sx-island-scope" nil) (let ((marker (create-comment "r-cond")) (current-nodes (list)) (initial-result nil)) (effect (fn () (let ((branch (eval-cond (rest expr) env))) (if (dom-parent marker) ;; In DOM — swap nodes (do (for-each (fn (n) (dom-remove n)) current-nodes) (set! current-nodes (list)) (when branch (let ((result (render-to-dom branch env ns))) (set! current-nodes (if (dom-is-fragment? result) (dom-child-nodes result) (list result))) (dom-insert-after marker result)))) ;; First run — save result for fragment (when branch (let ((result (render-to-dom branch env ns))) (set! current-nodes (if (dom-is-fragment? result) (dom-child-nodes result) (list result))) (set! initial-result result))))))) ;; Spread pass-through (if (spread? initial-result) initial-result (let ((frag (create-fragment))) (dom-append frag marker) (when initial-result (dom-append frag initial-result)) frag))) ;; Static 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* — single body: pass through (spread propagates). Multi: fragment. (or (= name "let") (= name "let*")) (let ((local (process-bindings (nth expr 1) env))) (if (= (len expr) 3) (render-to-dom (nth expr 2) local ns) (let ((frag (create-fragment))) (for-each (fn (i) (let ((result (render-to-dom (nth expr i) local ns))) (when (not (spread? result)) (dom-append frag result)))) (range 2 (len expr))) frag))) ;; begin / do — single body: pass through. Multi: fragment. (or (= name "begin") (= name "do")) (if (= (len expr) 2) (render-to-dom (nth expr 1) env ns) (let ((frag (create-fragment))) (for-each (fn (i) (let ((result (render-to-dom (nth expr i) env ns))) (when (not (spread? result)) (dom-append frag result)))) (range 1 (len expr))) frag)) ;; Definition forms — eval for side effects (definition-form? name) (do (trampoline (eval-expr expr env)) (create-fragment)) ;; map — reactive-list when mapping over a signal inside an island (= name "map") (let ((coll-expr (nth expr 2))) (if (and (context "sx-island-scope" nil) (= (type-of coll-expr) "list") (> (len coll-expr) 1) (= (type-of (first coll-expr)) "symbol") (= (symbol-name (first coll-expr)) "deref")) ;; Reactive path: pass signal to reactive-list (let ((f (trampoline (eval-expr (nth expr 1) env))) (sig (trampoline (eval-expr (nth coll-expr 1) env)))) (if (signal? sig) (reactive-list f sig env ns) ;; deref on non-signal: fall through to static (let ((coll (deref sig)) (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))) ;; Static path: no island scope or no deref (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) ;; portal — render children into a remote target element (= name "portal") (render-dom-portal (rest expr) env ns) ;; error-boundary — catch errors, render fallback (= name "error-boundary") (render-dom-error-boundary (rest expr) 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) ;; scope — unified render-time dynamic scope (= name "scope") (let ((scope-name (trampoline (eval-expr (nth expr 1) env))) (rest-args (slice expr 2)) (scope-val nil) (body-exprs nil) (frag (create-fragment))) ;; Check for :value keyword (if (and (>= (len rest-args) 2) (= (type-of (first rest-args)) "keyword") (= (keyword-name (first rest-args)) "value")) (do (set! scope-val (trampoline (eval-expr (nth rest-args 1) env))) (set! body-exprs (slice rest-args 2))) (set! body-exprs rest-args)) (scope-push! scope-name scope-val) (for-each (fn (e) (dom-append frag (render-to-dom e env ns))) body-exprs) (scope-pop! scope-name) frag) ;; provide — sugar for scope with value (= name "provide") (let ((prov-name (trampoline (eval-expr (nth expr 1) env))) (prov-val (trampoline (eval-expr (nth expr 2) env))) (frag (create-fragment))) (scope-push! prov-name prov-val) (for-each (fn (i) (dom-append frag (render-to-dom (nth expr i) env ns))) (range 3 (len expr))) (scope-pop! prov-name) 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 :effects [render] (fn ((f :as lambda) (args :as list) (env :as dict) (ns :as string)) ;; Bind lambda params and render body as DOM (let ((local (env-merge (lambda-closure f) env))) (for-each-indexed (fn (i p) (env-bind! 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 :effects [render mutation] (fn ((island :as island) (args :as list) (env :as dict) (ns :as string)) ;; 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-bind! 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-bind! local "children" child-frag))) ;; Create the island container element (let ((container (dom-create-element "span" nil)) (disposers (list))) ;; Mark as island + already hydrated (so boot.sx skips it) (dom-set-attr container "data-sx-island" island-name) (mark-processed! container "island-hydrated") ;; 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)))))) ;; -------------------------------------------------------------------------- ;; render-dom-lake — server-morphable slot within an island ;; -------------------------------------------------------------------------- ;; ;; (lake :id "name" children...) ;; ;; Renders as