giles
46f77c3b1e
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>
592 lines
18 KiB
Plaintext
592 lines
18 KiB
Plaintext
(define
|
|
render-to-html
|
|
:effects (render)
|
|
(fn
|
|
(expr (env :as dict))
|
|
(set-render-active! true)
|
|
(case
|
|
(type-of expr)
|
|
"nil"
|
|
""
|
|
"string"
|
|
(escape-html expr)
|
|
"number"
|
|
(str expr)
|
|
"boolean"
|
|
(if expr "true" "false")
|
|
"list"
|
|
(if (empty? expr) "" (render-list-to-html expr env))
|
|
"symbol"
|
|
(render-value-to-html (trampoline (eval-expr expr env)) env)
|
|
"keyword"
|
|
(escape-html (keyword-name expr))
|
|
"raw-html"
|
|
(raw-html-content expr)
|
|
"spread"
|
|
(do (scope-emit! "element-attrs" (spread-attrs expr)) "")
|
|
"thunk"
|
|
(render-to-html (thunk-expr expr) (thunk-env expr))
|
|
:else (render-value-to-html (trampoline (eval-expr expr env)) env))))
|
|
|
|
(define
|
|
render-value-to-html
|
|
:effects (render)
|
|
(fn
|
|
(val (env :as dict))
|
|
(case
|
|
(type-of val)
|
|
"nil"
|
|
""
|
|
"string"
|
|
(escape-html val)
|
|
"number"
|
|
(str val)
|
|
"boolean"
|
|
(if val "true" "false")
|
|
"list"
|
|
(render-list-to-html val env)
|
|
"raw-html"
|
|
(raw-html-content val)
|
|
"spread"
|
|
(do (scope-emit! "element-attrs" (spread-attrs val)) "")
|
|
"thunk"
|
|
(render-to-html (thunk-expr val) (thunk-env val))
|
|
:else (escape-html (str val)))))
|
|
|
|
(define
|
|
RENDER_HTML_FORMS
|
|
(list
|
|
"if"
|
|
"when"
|
|
"cond"
|
|
"case"
|
|
"let"
|
|
"let*"
|
|
"letrec"
|
|
"begin"
|
|
"do"
|
|
"define"
|
|
"defcomp"
|
|
"defisland"
|
|
"defmacro"
|
|
"defstyle"
|
|
"deftype"
|
|
"defeffect"
|
|
"map"
|
|
"map-indexed"
|
|
"filter"
|
|
"for-each"
|
|
"scope"
|
|
"provide"))
|
|
|
|
(define
|
|
render-html-form?
|
|
:effects ()
|
|
(fn ((name :as string)) (contains? RENDER_HTML_FORMS name)))
|
|
|
|
(define
|
|
render-list-to-html
|
|
:effects (render)
|
|
(fn
|
|
((expr :as list) (env :as dict))
|
|
(if
|
|
(empty? expr)
|
|
""
|
|
(let
|
|
((head (first expr)))
|
|
(if
|
|
(not (= (type-of head) "symbol"))
|
|
(join "" (map (fn (x) (render-value-to-html x env)) expr))
|
|
(let
|
|
((name (symbol-name head)) (args (rest expr)))
|
|
(cond
|
|
(= name "<>")
|
|
(join "" (map (fn (x) (render-to-html x env)) args))
|
|
(= name "raw!")
|
|
(join
|
|
""
|
|
(map (fn (x) (str (trampoline (eval-expr x env)))) args))
|
|
(= name "lake")
|
|
(render-html-lake args env)
|
|
(= name "marsh")
|
|
(render-html-marsh args env)
|
|
(= 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) "<" "<") ">" ">")))
|
|
(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)
|
|
(and
|
|
(starts-with? name "~")
|
|
(env-has? env name)
|
|
(island? (env-get env name)))
|
|
(render-html-island (env-get env name) args env)
|
|
(starts-with? name "~")
|
|
(let
|
|
((val (env-get env name)))
|
|
(cond
|
|
(component? val)
|
|
(render-html-component val args env)
|
|
(macro? val)
|
|
(render-to-html (expand-macro val args env) env)
|
|
:else (str "<!-- unknown component: " name " -->")))
|
|
(render-html-form? name)
|
|
(dispatch-html-form name expr env)
|
|
(and (env-has? env name) (macro? (env-get env name)))
|
|
(render-to-html (expand-macro (env-get env name) args env) env)
|
|
:else (render-value-to-html (trampoline (eval-expr expr env)) env))))))))
|
|
|
|
(define
|
|
dispatch-html-form
|
|
:effects (render)
|
|
(fn
|
|
((name :as string) (expr :as list) (env :as dict))
|
|
(cond
|
|
(= name "if")
|
|
(let
|
|
((cond-val (trampoline (eval-expr (nth expr 1) env))))
|
|
(if
|
|
cond-val
|
|
(render-to-html (nth expr 2) env)
|
|
(if (> (len expr) 3) (render-to-html (nth expr 3) env) "")))
|
|
(= name "when")
|
|
(if
|
|
(not (trampoline (eval-expr (nth expr 1) env)))
|
|
""
|
|
(if
|
|
(= (len expr) 3)
|
|
(render-to-html (nth expr 2) env)
|
|
(join
|
|
""
|
|
(map
|
|
(fn (i) (render-to-html (nth expr i) env))
|
|
(range 2 (len expr))))))
|
|
(= name "cond")
|
|
(let
|
|
((branch (eval-cond (rest expr) env)))
|
|
(if branch (render-to-html branch env) ""))
|
|
(= name "case")
|
|
(render-to-html (trampoline (eval-expr expr env)) env)
|
|
(= name "letrec")
|
|
(let
|
|
((bindings (nth expr 1))
|
|
(body (slice expr 2))
|
|
(local (env-extend env)))
|
|
(for-each
|
|
(fn
|
|
(pair)
|
|
(let
|
|
((pname (if (= (type-of (first pair)) "symbol") (symbol-name (first pair)) (str (first pair)))))
|
|
(env-bind! local pname nil)))
|
|
bindings)
|
|
(for-each
|
|
(fn
|
|
(pair)
|
|
(let
|
|
((pname (if (= (type-of (first pair)) "symbol") (symbol-name (first pair)) (str (first pair)))))
|
|
(env-set!
|
|
local
|
|
pname
|
|
(trampoline (eval-expr (nth pair 1) local)))))
|
|
bindings)
|
|
(when
|
|
(> (len body) 1)
|
|
(for-each (fn (e) (trampoline (eval-expr e local))) (init body)))
|
|
(render-to-html (last body) local))
|
|
(or (= name "let") (= name "let*"))
|
|
(let
|
|
((local (process-bindings (nth expr 1) env)))
|
|
(if
|
|
(= (len expr) 3)
|
|
(render-to-html (nth expr 2) local)
|
|
(join
|
|
""
|
|
(map
|
|
(fn (i) (render-to-html (nth expr i) local))
|
|
(range 2 (len expr))))))
|
|
(or (= name "begin") (= name "do"))
|
|
(if
|
|
(= (len expr) 2)
|
|
(render-to-html (nth expr 1) env)
|
|
(join
|
|
""
|
|
(map
|
|
(fn (i) (render-to-html (nth expr i) env))
|
|
(range 1 (len expr)))))
|
|
(definition-form? name)
|
|
(do (trampoline (eval-expr expr env)) "")
|
|
(= name "map")
|
|
(let
|
|
((f (trampoline (eval-expr (nth expr 1) env)))
|
|
(coll (trampoline (eval-expr (nth expr 2) env))))
|
|
(join
|
|
""
|
|
(map
|
|
(fn
|
|
(item)
|
|
(if
|
|
(lambda? f)
|
|
(render-lambda-html f (list item) env)
|
|
(render-to-html (apply f (list item)) env)))
|
|
coll)))
|
|
(= name "map-indexed")
|
|
(let
|
|
((f (trampoline (eval-expr (nth expr 1) env)))
|
|
(coll (trampoline (eval-expr (nth expr 2) env))))
|
|
(join
|
|
""
|
|
(map-indexed
|
|
(fn
|
|
(i item)
|
|
(if
|
|
(lambda? f)
|
|
(render-lambda-html f (list i item) env)
|
|
(render-to-html (apply f (list i item)) env)))
|
|
coll)))
|
|
(= name "filter")
|
|
(render-to-html (trampoline (eval-expr expr env)) env)
|
|
(= name "for-each")
|
|
(let
|
|
((f (trampoline (eval-expr (nth expr 1) env)))
|
|
(coll (trampoline (eval-expr (nth expr 2) env))))
|
|
(join
|
|
""
|
|
(map
|
|
(fn
|
|
(item)
|
|
(if
|
|
(lambda? f)
|
|
(render-lambda-html f (list item) env)
|
|
(render-to-html (apply f (list item)) env)))
|
|
coll)))
|
|
(= name "scope")
|
|
(let
|
|
((scope-name (trampoline (eval-expr (nth expr 1) env)))
|
|
(rest-args (slice expr 2))
|
|
(scope-val nil)
|
|
(body-exprs nil))
|
|
(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)
|
|
(let
|
|
((result (if (= (len body-exprs) 1) (render-to-html (first body-exprs) env) (join "" (map (fn (e) (render-to-html e env)) body-exprs)))))
|
|
(scope-pop! scope-name)
|
|
result))
|
|
(= name "provide")
|
|
(let
|
|
((prov-name (trampoline (eval-expr (nth expr 1) env)))
|
|
(prov-val (trampoline (eval-expr (nth expr 2) env)))
|
|
(body-start 3)
|
|
(body-count (- (len expr) 3)))
|
|
(scope-push! prov-name prov-val)
|
|
(let
|
|
((result (if (= body-count 1) (render-to-html (nth expr body-start) env) (join "" (map (fn (i) (render-to-html (nth expr i) env)) (range body-start (+ body-start body-count)))))))
|
|
(scope-pop! prov-name)
|
|
result))
|
|
:else (render-value-to-html (trampoline (eval-expr expr env)) env))))
|
|
|
|
(define
|
|
render-lambda-html
|
|
:effects (render)
|
|
(fn
|
|
((f :as lambda) (args :as list) (env :as dict))
|
|
(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-html (lambda-body f) local))))
|
|
|
|
(define
|
|
render-html-component
|
|
:effects (render)
|
|
(fn
|
|
((comp :as component) (args :as list) (env :as dict))
|
|
(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)
|
|
(let
|
|
((local (env-merge (component-closure comp) env)))
|
|
(for-each
|
|
(fn
|
|
(p)
|
|
(env-bind!
|
|
local
|
|
p
|
|
(if (dict-has? kwargs p) (dict-get kwargs p) nil)))
|
|
(component-params comp))
|
|
(when
|
|
(component-has-children? comp)
|
|
(env-bind!
|
|
local
|
|
"children"
|
|
(make-raw-html
|
|
(join "" (map (fn (c) (render-to-html c env)) children)))))
|
|
(render-to-html (component-body comp) local)))))
|
|
|
|
(define
|
|
render-html-element
|
|
:effects (render)
|
|
(fn
|
|
((tag :as string) (args :as list) (env :as dict))
|
|
(let
|
|
((parsed (parse-element-args args env))
|
|
(attrs (first parsed))
|
|
(children (nth parsed 1))
|
|
(is-void (contains? VOID_ELEMENTS tag)))
|
|
(if
|
|
is-void
|
|
(str "<" tag (render-attrs attrs) " />")
|
|
(do
|
|
(scope-push! "element-attrs" nil)
|
|
(let
|
|
((content (join "" (map (fn (c) (render-to-html c env)) children))))
|
|
(for-each
|
|
(fn (spread-dict) (merge-spread-attrs attrs spread-dict))
|
|
(scope-emitted "element-attrs"))
|
|
(scope-pop! "element-attrs")
|
|
(str "<" tag (render-attrs attrs) ">" content "</" tag ">")))))))
|
|
|
|
(define
|
|
render-html-lake
|
|
:effects (render)
|
|
(fn
|
|
((args :as list) (env :as dict))
|
|
(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
|
|
((lake-attrs (dict "data-sx-lake" (or lake-id ""))))
|
|
(scope-push! "element-attrs" nil)
|
|
(let
|
|
((content (join "" (map (fn (c) (render-to-html c env)) children))))
|
|
(for-each
|
|
(fn (spread-dict) (merge-spread-attrs lake-attrs spread-dict))
|
|
(scope-emitted "element-attrs"))
|
|
(scope-pop! "element-attrs")
|
|
(str
|
|
"<"
|
|
lake-tag
|
|
(render-attrs lake-attrs)
|
|
">"
|
|
content
|
|
"</"
|
|
lake-tag
|
|
">"))))))
|
|
|
|
(define
|
|
render-html-marsh
|
|
:effects (render)
|
|
(fn
|
|
((args :as list) (env :as dict))
|
|
(let
|
|
((marsh-id nil) (marsh-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! marsh-id kval)
|
|
(= kname "tag")
|
|
(set! marsh-tag kval)
|
|
(= kname "transform")
|
|
nil)
|
|
(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
|
|
((marsh-attrs (dict "data-sx-marsh" (or marsh-id ""))))
|
|
(scope-push! "element-attrs" nil)
|
|
(let
|
|
((content (join "" (map (fn (c) (render-to-html c env)) children))))
|
|
(for-each
|
|
(fn (spread-dict) (merge-spread-attrs marsh-attrs spread-dict))
|
|
(scope-emitted "element-attrs"))
|
|
(scope-pop! "element-attrs")
|
|
(str
|
|
"<"
|
|
marsh-tag
|
|
(render-attrs marsh-attrs)
|
|
">"
|
|
content
|
|
"</"
|
|
marsh-tag
|
|
">"))))))
|
|
|
|
(define
|
|
render-html-island
|
|
:effects (render)
|
|
(fn
|
|
((island :as island) (args :as list) (env :as dict))
|
|
(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)
|
|
(let
|
|
((local (env-merge (component-closure island) env))
|
|
(island-name (component-name island)))
|
|
(for-each
|
|
(fn
|
|
(p)
|
|
(env-bind!
|
|
local
|
|
p
|
|
(if (dict-has? kwargs p) (dict-get kwargs p) nil)))
|
|
(component-params island))
|
|
(when
|
|
(component-has-children? island)
|
|
(env-bind!
|
|
local
|
|
"children"
|
|
(make-raw-html
|
|
(join "" (map (fn (c) (render-to-html c env)) children)))))
|
|
(let
|
|
((body-html (render-to-html (component-body island) local))
|
|
(state-sx (serialize-island-state kwargs)))
|
|
(str
|
|
"<span data-sx-island=\""
|
|
(escape-attr island-name)
|
|
"\""
|
|
(if
|
|
state-sx
|
|
(str " data-sx-state=\"" (escape-attr state-sx) "\"")
|
|
"")
|
|
">"
|
|
body-html
|
|
"</span>"))))))
|
|
|
|
(define
|
|
serialize-island-state
|
|
:effects ()
|
|
(fn
|
|
((kwargs :as dict))
|
|
(if (empty-dict? kwargs) nil (sx-serialize kwargs))))
|