giles
ea2b71cfa3
Four new primitives for scoped downward value passing and upward accumulation through the render tree. Specced in .sx, bootstrapped to Python and JS across all adapters (eval, html, sx, dom, async). Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
1155 lines
48 KiB
Plaintext
1155 lines
48 KiB
Plaintext
;; ==========================================================================
|
|
;; 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 → pass through (parent element handles it)
|
|
"spread" 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 *island-scope*
|
|
(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") *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 :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)))
|
|
|
|
;; 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).
|
|
*island-scope*
|
|
(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)))
|
|
(if (spread? child)
|
|
;; Spread: merge attrs onto parent element
|
|
(for-each
|
|
(fn ((key :as string))
|
|
(let ((val (dict-get (spread-attrs child) key)))
|
|
(if (= key "class")
|
|
;; Class: append to existing
|
|
(let ((existing (dom-get-attr el "class")))
|
|
(dom-set-attr el "class"
|
|
(if (and existing (not (= existing "")))
|
|
(str existing " " val)
|
|
val)))
|
|
(if (= key "style")
|
|
;; Style: append with semicolon
|
|
(let ((existing (dom-get-attr el "style")))
|
|
(dom-set-attr el "style"
|
|
(if (and existing (not (= existing "")))
|
|
(str existing ";" val)
|
|
val)))
|
|
;; Other attrs: overwrite
|
|
(dom-set-attr el key (str val))))))
|
|
(keys (spread-attrs child)))
|
|
;; Normal child: append to element
|
|
(dom-append el child))))
|
|
(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 :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-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 :effects [render]
|
|
(fn ((args :as list) (env :as dict) (ns :as string))
|
|
(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 :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" "defhandler"
|
|
"map" "map-indexed" "filter" "for-each" "portal"
|
|
"error-boundary" "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 *island-scope*
|
|
(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)))))
|
|
;; Return fragment: marker + initial render 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 *island-scope*
|
|
(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))))))
|
|
(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 *island-scope*
|
|
(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)))))))
|
|
(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*
|
|
(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 — reactive-list when mapping over a signal inside an island
|
|
(= name "map")
|
|
(let ((coll-expr (nth expr 2)))
|
|
(if (and *island-scope*
|
|
(= (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)
|
|
|
|
;; provide — render-time dynamic scope
|
|
(= name "provide")
|
|
(let ((prov-name (trampoline (eval-expr (nth expr 1) env)))
|
|
(prov-val (trampoline (eval-expr (nth expr 2) env)))
|
|
(frag (create-fragment)))
|
|
(provide-push! prov-name prov-val)
|
|
(for-each
|
|
(fn (i)
|
|
(dom-append frag (render-to-dom (nth expr i) env ns)))
|
|
(range 3 (len expr)))
|
|
(provide-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-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 :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-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 "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 <div data-sx-lake="name">children</div>.
|
|
;; During morph, the server can replace lake content while the surrounding
|
|
;; reactive island DOM is preserved. This is the "water around the rocks" —
|
|
;; server substance flowing through client territory.
|
|
;;
|
|
;; Supports :tag keyword to change wrapper element (default "div").
|
|
|
|
(define render-dom-lake :effects [render]
|
|
(fn ((args :as list) (env :as dict) (ns :as string))
|
|
(let ((lake-id nil)
|
|
(lake-tag "div")
|
|
(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 ((kname (keyword-name arg))
|
|
(kval (trampoline (eval-expr (nth args (inc (get state "i"))) env))))
|
|
(cond
|
|
(= kname "id") (set! lake-id kval)
|
|
(= kname "tag") (set! lake-tag kval))
|
|
(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)
|
|
(let ((el (dom-create-element lake-tag nil)))
|
|
(dom-set-attr el "data-sx-lake" (or lake-id ""))
|
|
(for-each
|
|
(fn (c) (dom-append el (render-to-dom c env ns)))
|
|
children)
|
|
el))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; render-dom-marsh — reactive server-morphable slot within an island
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; (marsh :id "name" :tag "div" :transform fn children...)
|
|
;;
|
|
;; Like a lake but reactive: during morph, new content is parsed as SX and
|
|
;; re-evaluated in the island's signal scope. The :transform function (if
|
|
;; present) reshapes server content before evaluation.
|
|
;;
|
|
;; Renders as <div data-sx-marsh="name">children</div>.
|
|
;; Stores the island env and transform on the element for morph retrieval.
|
|
|
|
(define render-dom-marsh :effects [render]
|
|
(fn ((args :as list) (env :as dict) (ns :as string))
|
|
(let ((marsh-id nil)
|
|
(marsh-tag "div")
|
|
(marsh-transform nil)
|
|
(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 ((kname (keyword-name arg))
|
|
(kval (trampoline (eval-expr (nth args (inc (get state "i"))) env))))
|
|
(cond
|
|
(= kname "id") (set! marsh-id kval)
|
|
(= kname "tag") (set! marsh-tag kval)
|
|
(= kname "transform") (set! marsh-transform kval))
|
|
(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)
|
|
(let ((el (dom-create-element marsh-tag nil)))
|
|
(dom-set-attr el "data-sx-marsh" (or marsh-id ""))
|
|
;; Store transform function and island env for morph retrieval
|
|
(when marsh-transform
|
|
(dom-set-data el "sx-marsh-transform" marsh-transform))
|
|
(dom-set-data el "sx-marsh-env" env)
|
|
(for-each
|
|
(fn (c) (dom-append el (render-to-dom c env ns)))
|
|
children)
|
|
el))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 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 :effects [render mutation]
|
|
(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.
|
|
;; Marks the attribute name on the element via data-sx-reactive-attrs so
|
|
;; the morph algorithm knows not to overwrite it with server content.
|
|
(define reactive-attr :effects [render mutation]
|
|
(fn (el (attr-name :as string) (compute-fn :as lambda))
|
|
;; Mark this attribute as reactively managed
|
|
(let ((existing (or (dom-get-attr el "data-sx-reactive-attrs") ""))
|
|
(updated (if (empty? existing) attr-name (str existing "," attr-name))))
|
|
(dom-set-attr el "data-sx-reactive-attrs" updated))
|
|
(effect (fn ()
|
|
(let ((raw (compute-fn)))
|
|
;; If compute-fn returned a signal (e.g. from computed), deref it
|
|
;; to get the actual value and track the dependency
|
|
(let ((val (if (signal? raw) (deref raw) raw)))
|
|
(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 :effects [render mutation]
|
|
(fn ((test-fn :as lambda) (render-fn :as lambda) (env :as dict) (ns :as string))
|
|
(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.
|
|
;;
|
|
;; Keyed reconciliation: if rendered elements have a "key" attribute,
|
|
;; existing DOM nodes are reused across updates. Only additions, removals,
|
|
;; and reorderings touch the DOM. Without keys, falls back to clear+rerender.
|
|
|
|
(define render-list-item :effects [render]
|
|
(fn ((map-fn :as lambda) item (env :as dict) (ns :as string))
|
|
(if (lambda? map-fn)
|
|
(render-lambda-dom map-fn (list item) env ns)
|
|
(render-to-dom (apply map-fn (list item)) env ns))))
|
|
|
|
(define extract-key :effects [render]
|
|
(fn (node (index :as number))
|
|
;; Extract key from rendered node: :key attr, data-key, or index fallback
|
|
(let ((k (dom-get-attr node "key")))
|
|
(if k
|
|
(do (dom-remove-attr node "key") k)
|
|
(let ((dk (dom-get-data node "key")))
|
|
(if dk (str dk) (str "__idx_" index)))))))
|
|
|
|
(define reactive-list :effects [render mutation]
|
|
(fn ((map-fn :as lambda) (items-sig :as signal) (env :as dict) (ns :as string))
|
|
(let ((container (create-fragment))
|
|
(marker (create-comment "island-list"))
|
|
(key-map (dict))
|
|
(key-order (list)))
|
|
(dom-append container marker)
|
|
(effect (fn ()
|
|
(let ((items (deref items-sig)))
|
|
(if (dom-parent marker)
|
|
;; Marker in DOM: reconcile
|
|
(let ((new-map (dict))
|
|
(new-keys (list))
|
|
(has-keys false))
|
|
|
|
;; Render or reuse each item
|
|
(for-each-indexed
|
|
(fn (idx item)
|
|
(let ((rendered (render-list-item map-fn item env ns))
|
|
(key (extract-key rendered idx)))
|
|
(when (and (not has-keys)
|
|
(not (starts-with? key "__idx_")))
|
|
(set! has-keys true))
|
|
;; Reuse existing node if key matches, else use new
|
|
(if (dict-has? key-map key)
|
|
(dict-set! new-map key (dict-get key-map key))
|
|
(dict-set! new-map key rendered))
|
|
(append! new-keys key)))
|
|
items)
|
|
|
|
(if (not has-keys)
|
|
;; No keys: simple clear and re-render (original strategy)
|
|
(do
|
|
(dom-remove-children-after marker)
|
|
(let ((frag (create-fragment)))
|
|
(for-each
|
|
(fn (k) (dom-append frag (dict-get new-map k)))
|
|
new-keys)
|
|
(dom-insert-after marker frag)))
|
|
|
|
;; Keyed reconciliation
|
|
(do
|
|
;; Remove stale nodes
|
|
(for-each
|
|
(fn (old-key)
|
|
(when (not (dict-has? new-map old-key))
|
|
(dom-remove (dict-get key-map old-key))))
|
|
key-order)
|
|
|
|
;; Reorder/insert to match new key order
|
|
(let ((cursor marker))
|
|
(for-each
|
|
(fn (k)
|
|
(let ((node (dict-get new-map k))
|
|
(next (dom-next-sibling cursor)))
|
|
(when (not (identical? node next))
|
|
(dom-insert-after cursor node))
|
|
(set! cursor node)))
|
|
new-keys))))
|
|
|
|
;; Update state for next render
|
|
(set! key-map new-map)
|
|
(set! key-order new-keys))
|
|
|
|
;; First run (marker not in DOM yet): render initial items into container
|
|
(for-each-indexed
|
|
(fn (idx item)
|
|
(let ((rendered (render-list-item map-fn item env ns))
|
|
(key (extract-key rendered idx)))
|
|
(dict-set! key-map key rendered)
|
|
(append! key-order key)
|
|
(dom-append container rendered)))
|
|
items)))))
|
|
container)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; bind-input — two-way signal binding for form elements
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; (bind-input el sig) creates a bidirectional link:
|
|
;; Signal → element: effect updates el.value (or el.checked) when sig changes
|
|
;; Element → signal: input/change listener updates sig when user types
|
|
;;
|
|
;; Handles: input[text/number/email/...], textarea, select, checkbox, radio
|
|
|
|
(define bind-input :effects [render mutation]
|
|
(fn (el (sig :as signal))
|
|
(let ((input-type (lower (or (dom-get-attr el "type") "")))
|
|
(is-checkbox (or (= input-type "checkbox")
|
|
(= input-type "radio"))))
|
|
;; Set initial value from signal
|
|
(if is-checkbox
|
|
(dom-set-prop el "checked" (deref sig))
|
|
(dom-set-prop el "value" (str (deref sig))))
|
|
;; Signal → element (reactive effect)
|
|
(effect (fn ()
|
|
(if is-checkbox
|
|
(dom-set-prop el "checked" (deref sig))
|
|
(let ((v (str (deref sig))))
|
|
(when (!= (dom-get-prop el "value") v)
|
|
(dom-set-prop el "value" v))))))
|
|
;; Element → signal (event listener)
|
|
(dom-listen el (if is-checkbox "change" "input")
|
|
(fn (e)
|
|
(if is-checkbox
|
|
(reset! sig (dom-get-prop el "checked"))
|
|
(reset! sig (dom-get-prop el "value"))))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; render-dom-portal — render children into a remote target element
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; (portal "#modal-root" (div "content"))
|
|
;;
|
|
;; Renders children into the DOM node matched by the selector, rather than
|
|
;; into the current position. Returns a comment marker at the original
|
|
;; position. Registers a disposer to clean up portal content on island
|
|
;; teardown.
|
|
|
|
(define render-dom-portal :effects [render]
|
|
(fn ((args :as list) (env :as dict) (ns :as string))
|
|
(let ((selector (trampoline (eval-expr (first args) env)))
|
|
(target (or (dom-query selector)
|
|
(dom-ensure-element selector))))
|
|
(if (not target)
|
|
(create-comment (str "portal: " selector " (not found)"))
|
|
(let ((marker (create-comment (str "portal: " selector)))
|
|
(frag (create-fragment)))
|
|
;; Render children into the fragment
|
|
(for-each
|
|
(fn (child) (dom-append frag (render-to-dom child env ns)))
|
|
(rest args))
|
|
;; Track portal nodes for disposal
|
|
(let ((portal-nodes (dom-child-nodes frag)))
|
|
;; Append into remote target
|
|
(dom-append target frag)
|
|
;; Register disposer: remove portal content on island teardown
|
|
(register-in-scope
|
|
(fn ()
|
|
(for-each (fn (n) (dom-remove n)) portal-nodes))))
|
|
;; Return marker at original position
|
|
marker)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; render-dom-error-boundary — catch errors, render fallback UI
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; (error-boundary fallback-fn body...)
|
|
;;
|
|
;; Renders body children inside a try/catch. If any child throws during
|
|
;; rendering, the fallback function is called with the error object, and
|
|
;; its result is rendered instead. Effects within the boundary are disposed
|
|
;; on error.
|
|
;;
|
|
;; The fallback function receives the error and a retry thunk:
|
|
;; (fn (err retry) ...)
|
|
;; Calling (retry) re-renders the body, replacing the fallback.
|
|
|
|
(define render-dom-error-boundary :effects [render]
|
|
(fn ((args :as list) (env :as dict) (ns :as string))
|
|
(let ((fallback-expr (first args))
|
|
(body-exprs (rest args))
|
|
(container (dom-create-element "div" nil))
|
|
;; retry-version: bump this signal to force re-render after fallback
|
|
(retry-version (signal 0)))
|
|
(dom-set-attr container "data-sx-boundary" "true")
|
|
|
|
;; The entire body is rendered inside ONE effect + try-catch.
|
|
;; Body renders WITHOUT *island-scope* so that if/when/cond use static
|
|
;; paths — their signal reads become direct deref calls tracked by THIS
|
|
;; effect. Errors from signal changes throw synchronously within try-catch.
|
|
;; The error boundary's own effect handles all reactivity for its subtree.
|
|
(effect (fn ()
|
|
;; Touch retry-version so the effect re-runs when retry is called
|
|
(deref retry-version)
|
|
|
|
;; Clear container
|
|
(dom-set-prop container "innerHTML" "")
|
|
|
|
;; Save and clear island scope BEFORE try-catch so it can be
|
|
;; restored in both success and error paths.
|
|
(let ((saved-scope *island-scope*))
|
|
(set! *island-scope* nil)
|
|
(try-catch
|
|
(fn ()
|
|
;; Body renders statically — signal reads tracked by THIS effect,
|
|
;; throws propagate to our try-catch.
|
|
(let ((frag (create-fragment)))
|
|
(for-each
|
|
(fn (child)
|
|
(dom-append frag (render-to-dom child env ns)))
|
|
body-exprs)
|
|
(dom-append container frag))
|
|
(set! *island-scope* saved-scope))
|
|
(fn (err)
|
|
;; Restore scope first, then render fallback
|
|
(set! *island-scope* saved-scope)
|
|
(let ((fallback-fn (trampoline (eval-expr fallback-expr env)))
|
|
(retry-fn (fn () (swap! retry-version (fn (n) (+ n 1))))))
|
|
(let ((fallback-dom
|
|
(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))))))))
|
|
|
|
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)
|
|
;;
|
|
;; Property access (for input binding):
|
|
;; (dom-set-prop el name val) → void (set JS property: el[name] = val)
|
|
;; (dom-get-prop el name) → any (read JS property: el[name])
|
|
;;
|
|
;; Query (for portals):
|
|
;; (dom-query selector) → Element or nil (document.querySelector)
|
|
;;
|
|
;; 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, register-in-scope
|
|
;;
|
|
;; Pure primitives used:
|
|
;; keys, get, str
|
|
;;
|
|
;; Iteration:
|
|
;; (for-each-indexed fn coll) → call fn(index, item) for each element
|
|
;; --------------------------------------------------------------------------
|