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

Adapter fixes, orchestration updates, example content + SPA tests

Browse Source 
From other session: adapter-html/sx/dom fixes, orchestration
improvements, examples-content refactoring, SPA navigation test
updates, WASM copies synced.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-01 13:35:49 +00:00
parent cd9ebc0cd8
commit 46f77c3b1e
15 changed files with 442 additions and 231 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
web/adapter-dom.sx
View File

@@ -1302,8 +1302,8 @@
(fn
((args :as list) (env :as dict) (ns :as string))
(let
((fallback-expr (first args))
(body-exprs (rest args))
((fallback-expr (if (> (len args) 1) (first args) nil))
(body-exprs (if (> (len args) 1) (rest args) args))
(container (dom-create-element "div" nil))
(retry-version (signal 0)))
(dom-set-attr container "data-sx-boundary" "true")
@@ -1333,6 +1333,6 @@
(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))))
((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)))))))
container)))

45
web/adapter-html.sx
View File

@@ -110,10 +110,47 @@
(render-html-lake args env)
(= name "marsh")
(render-html-marsh args env)
(or
(= name "portal")
(= name "error-boundary")
(= name "promise-delayed"))
(= name "error-boundary")
(let
((has-fallback (> (len args) 1)))
(let
((body-exprs (if has-fallback (rest args) args))
(fallback-expr (if has-fallback (first args) nil)))
(str
"<div data-sx-boundary=\"true\">"
(try-catch
(fn
()
(join
""
(map (fn (x) (render-to-html x env)) body-exprs)))
(fn
(err)
(let
((safe-err (replace (replace (str err) "<" "&lt;") ">" "&gt;")))
(if
(and fallback-expr (not (nil? fallback-expr)))
(try-catch
(fn
()
(render-to-html
(list
(trampoline (eval-expr fallback-expr env))
err
nil)
env))
(fn
(e2)
(str
"<div class=\"sx-render-error\" style=\"color:red;font-size:0.875rem;padding:0.5rem;border:1px solid red;border-radius:0.25rem;margin:0.5rem 0;\">Render error: "
safe-err
"</div>")))
(str
"<div class=\"sx-render-error\" style=\"color:red;font-size:0.875rem;padding:0.5rem;border:1px solid red;border-radius:0.25rem;margin:0.5rem 0;\">Render error: "
safe-err
"</div>")))))
"</div>")))
(or (= name "portal") (= name "promise-delayed"))
(join "" (map (fn (x) (render-to-html x env)) args))
(contains? HTML_TAGS name)
(render-html-element name args env)

19
web/adapter-sx.sx
View File

@@ -66,7 +66,24 @@
(= name "marsh")
(aser-call name args env)
(= name "error-boundary")
(aser-call name args env)
(let
((has-fallback (> (len args) 1)))
(let
((body-exprs (if has-fallback (rest args) args))
(err-str nil))
(let
((rendered (try-catch (fn () (join "" (map (fn (x) (let ((v (aser x env))) (cond (= (type-of v) "sx-expr") (sx-expr-source v) (nil? v) "" :else (serialize v)))) body-exprs))) (fn (err) (set! err-str (str err)) nil))))
(if
rendered
(make-sx-expr (str "(error-boundary " rendered ")"))
(make-sx-expr
(str
"(div :data-sx-boundary \"true\" "
"(div :class \"sx-render-error\" "
":style \"color:red;font-size:0.875rem;padding:0.5rem;border:1px solid red;border-radius:0.25rem;margin:0.5rem 0;\" "
"\"Render error: "
(replace (replace err-str "\"" "'") "\\" "\\\\")
"\"))"))))))
(contains? HTML_TAGS name)
(aser-call name args env)
(or (special-form? name) (ho-form? name))

73
web/orchestration.sx
View File

@@ -288,24 +288,21 @@
s)
(post-swap t)))
(let
((select-sel (dom-get-attr el "sx-select"))
(content
(if
select-sel
(select-from-container container select-sel)
(children-to-fragment container))))
(dispose-islands-in target)
(with-transition
use-transition
(fn
()
(let
((swap-result (swap-dom-nodes target content swap-style)))
(post-swap
(if
(= swap-style "outerHTML")
(dom-parent (or swap-result target))
(or swap-result target))))))))))))))
((select-sel (dom-get-attr el "sx-select")))
(let
((content (if select-sel (select-from-container container select-sel) (children-to-fragment container))))
(dispose-islands-in target)
(with-transition
use-transition
(fn
()
(let
((swap-result (swap-dom-nodes target content swap-style)))
(post-swap
(if
(= swap-style "outerHTML")
(dom-parent (or swap-result target))
(or swap-result target)))))))))))))))
(define
handle-html-response
@@ -973,17 +970,35 @@
:effects (mutation io)
(fn
(target rendered (pathname :as string))
(do
(dispose-islands-in target)
(dom-set-text-content target "")
(dom-append target rendered)
(hoist-head-elements-full target)
(process-elements target)
(sx-hydrate-elements target)
(sx-hydrate-islands target)
(run-post-render-hooks)
(dom-dispatch target "sx:clientRoute" (dict "pathname" pathname))
(log-info (str "sx:route client " pathname)))))
(let
((container (dom-create-element "div" nil)))
(dom-append container rendered)
(process-oob-swaps
container
(fn
(t oob (s :as string))
(dispose-islands-in t)
(swap-dom-nodes
t
(if (= s "innerHTML") (children-to-fragment oob) oob)
s)
(post-swap t)))
(let
((target-id (dom-get-attr target "id")))
(let
((inner (if target-id (dom-query container (str "#" target-id)) nil)))
(let
((content (if inner (children-to-fragment inner) (children-to-fragment container))))
(dispose-islands-in target)
(dom-set-text-content target "")
(dom-append target content)
(hoist-head-elements-full target)
(process-elements target)
(sx-hydrate-elements target)
(sx-hydrate-islands target)
(run-post-render-hooks)
(dom-dispatch target "sx:clientRoute" (dict "pathname" pathname))
(log-info (str "sx:route client " pathname))))))))
(define
resolve-route-target