Test runner: SSR fix, cek-try primitive, HTML entity handling
- render-html-island wraps body SSR in cek-try (graceful fallback to empty container when island body has DOM/signal code) - defcomp placeholder pattern: server renders safe placeholder div with data-sx-island, browser hydrates the actual island - cek-try primitive added to both server and browser OCaml kernels - assert/assert= added to spec/harness.sx for standalone use - Test source stored in <script type="text/sx-test" data-for="..."> with HTML entity decoding via host-call replaceAll Temperature converter: 5 tests embedded in demo page. Test runner hydrates and finds tests but body render is empty — needs debugging of the specific construct that silently fails in render-to-dom. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -1,579 +1,25 @@
|
||||
;; ==========================================================================
|
||||
;; adapter-html.sx — HTML string rendering adapter
|
||||
;;
|
||||
;; Renders evaluated SX expressions to HTML strings. Used server-side.
|
||||
;;
|
||||
;; Depends on:
|
||||
;; render.sx — HTML_TAGS, VOID_ELEMENTS, BOOLEAN_ATTRS,
|
||||
;; parse-element-args, render-attrs, definition-form?
|
||||
;; 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
|
||||
;; ==========================================================================
|
||||
(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-to-html :effects [render]
|
||||
(fn (expr (env :as dict))
|
||||
(set-render-active! true)
|
||||
(case (type-of expr)
|
||||
;; Literals — render directly
|
||||
"nil" ""
|
||||
"string" (escape-html expr)
|
||||
"number" (str expr)
|
||||
"boolean" (if expr "true" "false")
|
||||
;; List — dispatch to render-list which handles HTML tags, special forms, etc.
|
||||
"list" (if (empty? expr) "" (render-list-to-html expr env))
|
||||
;; Symbol — evaluate then render
|
||||
"symbol" (render-value-to-html (trampoline (eval-expr expr env)) env)
|
||||
;; Keyword — render as text
|
||||
"keyword" (escape-html (keyword-name expr))
|
||||
;; Raw HTML passthrough
|
||||
"raw-html" (raw-html-content expr)
|
||||
;; Spread — emit attrs to nearest element provider
|
||||
"spread" (do (scope-emit! "element-attrs" (spread-attrs expr)) "")
|
||||
;; Thunk — unwrap and render the inner expression (from letrec TCO)
|
||||
"thunk" (render-to-html (thunk-expr expr) (thunk-env expr))
|
||||
;; Everything else — evaluate first
|
||||
:else (render-value-to-html (trampoline (eval-expr expr env)) env))))
|
||||
(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-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-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) (or (= name "portal") (= name "error-boundary") (= 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 (error (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))))))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Render-aware form classification
|
||||
;; --------------------------------------------------------------------------
|
||||
(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_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-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-form? :effects []
|
||||
(fn ((name :as string))
|
||||
(contains? RENDER_HTML_FORMS name)))
|
||||
(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 ">")))))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; render-list-to-html — dispatch on list head
|
||||
;; --------------------------------------------------------------------------
|
||||
(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-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"))
|
||||
;; Data list — render each item
|
||||
(join "" (map (fn (x) (render-value-to-html x env)) expr))
|
||||
(let ((name (symbol-name head))
|
||||
(args (rest expr)))
|
||||
(cond
|
||||
;; Fragment
|
||||
(= name "<>")
|
||||
(join "" (map (fn (x) (render-to-html x env)) args))
|
||||
(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 ">"))))))
|
||||
|
||||
;; Raw HTML passthrough
|
||||
(= name "raw!")
|
||||
(join "" (map (fn (x) (str (trampoline (eval-expr x env)))) args))
|
||||
(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 (cek-try (fn () (render-to-html (component-body island) local)) (fn (err) ""))) (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>"))))))
|
||||
|
||||
;; Lake — server-morphable slot within an island
|
||||
(= name "lake")
|
||||
(render-html-lake args env)
|
||||
|
||||
;; Marsh — reactive server-morphable slot within an island
|
||||
(= name "marsh")
|
||||
(render-html-marsh args env)
|
||||
|
||||
;; Client-only wrappers — render children, skip wrapper
|
||||
(or (= name "portal") (= name "error-boundary")
|
||||
(= name "promise-delayed"))
|
||||
(join "" (map (fn (x) (render-to-html x env)) args))
|
||||
|
||||
;; HTML tag
|
||||
(contains? HTML_TAGS name)
|
||||
(render-html-element name args env)
|
||||
|
||||
;; Island (~name) — reactive component, SSR with hydration markers
|
||||
(and (starts-with? name "~")
|
||||
(env-has? env name)
|
||||
(island? (env-get env name)))
|
||||
(render-html-island (env-get env name) args env)
|
||||
|
||||
;; Component or macro call (~name)
|
||||
(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
|
||||
(error (str "Unknown component: " name))))
|
||||
|
||||
;; Render-aware special forms
|
||||
(render-html-form? name)
|
||||
(dispatch-html-form name expr env)
|
||||
|
||||
;; Macro expansion
|
||||
(and (env-has? env name) (macro? (env-get env name)))
|
||||
(render-to-html
|
||||
(expand-macro (env-get env name) args env)
|
||||
env)
|
||||
|
||||
;; Fallback — evaluate then render result
|
||||
:else
|
||||
(render-value-to-html
|
||||
(trampoline (eval-expr expr env))
|
||||
env))))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; dispatch-html-form — render-aware special form handling for HTML output
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define dispatch-html-form :effects [render]
|
||||
(fn ((name :as string) (expr :as list) (env :as dict))
|
||||
(cond
|
||||
;; if
|
||||
(= 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)
|
||||
"")))
|
||||
|
||||
;; when — single body: pass through. Multi: join strings.
|
||||
(= 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))))))
|
||||
|
||||
;; cond
|
||||
(= name "cond")
|
||||
(let ((branch (eval-cond (rest expr) env)))
|
||||
(if branch
|
||||
(render-to-html branch env)
|
||||
""))
|
||||
|
||||
;; case
|
||||
(= name "case")
|
||||
(render-to-html (trampoline (eval-expr expr env)) env)
|
||||
|
||||
;; letrec — pre-bind all names (nil), evaluate values, render body.
|
||||
;; Can't use eval-expr on the whole form because the body contains
|
||||
;; render expressions (div, lake, etc.) that eval-expr can't handle.
|
||||
(= name "letrec")
|
||||
(let ((bindings (nth expr 1))
|
||||
(body (slice expr 2))
|
||||
(local (env-extend env)))
|
||||
;; Phase 1: pre-bind all names to nil
|
||||
(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)
|
||||
;; Phase 2: evaluate values (all names in scope for mutual recursion)
|
||||
(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)
|
||||
;; Phase 3: eval non-last body exprs for side effects, render last
|
||||
(when (> (len body) 1)
|
||||
(for-each (fn (e) (trampoline (eval-expr e local))) (init body)))
|
||||
(render-to-html (last body) local))
|
||||
|
||||
;; let / let* — single body: pass through. Multi: join strings.
|
||||
(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))))))
|
||||
|
||||
;; begin / do — single body: pass through. Multi: join strings.
|
||||
(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 forms — eval for side effects
|
||||
(definition-form? name)
|
||||
(do (trampoline (eval-expr expr env)) "")
|
||||
|
||||
;; map
|
||||
(= 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)))
|
||||
|
||||
;; map-indexed
|
||||
(= 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)))
|
||||
|
||||
;; filter — evaluate fully then render
|
||||
(= name "filter")
|
||||
(render-to-html (trampoline (eval-expr expr env)) env)
|
||||
|
||||
;; for-each (render variant)
|
||||
(= 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)))
|
||||
|
||||
;; 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))
|
||||
;; 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)
|
||||
(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))
|
||||
|
||||
;; 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)))
|
||||
(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))
|
||||
|
||||
;; Fallback
|
||||
:else
|
||||
(render-value-to-html (trampoline (eval-expr expr env)) env))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; render-lambda-html — render a lambda body in HTML context
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(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))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; render-html-component — expand and render a component
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-html-component :effects [render]
|
||||
(fn ((comp :as component) (args :as list) (env :as dict))
|
||||
;; Expand component and render body through HTML adapter.
|
||||
;; Component body contains rendering forms (HTML tags) that only the
|
||||
;; adapter understands, so expansion must happen here, not in eval-expr.
|
||||
(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)))
|
||||
(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 raw HTML
|
||||
(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) " />")
|
||||
;; Provide scope for spread emit!
|
||||
(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 ">")))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; render-html-lake — SSR rendering of a server-morphable slot
|
||||
;; --------------------------------------------------------------------------
|
||||
;;
|
||||
;; (lake :id "name" children...) → <div data-sx-lake="name">children</div>
|
||||
;;
|
||||
;; Lakes are server territory inside islands. The morph can update lake
|
||||
;; content while preserving surrounding reactive DOM.
|
||||
|
||||
(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)
|
||||
;; Provide scope for spread emit!
|
||||
(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 ">"))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; render-html-marsh — SSR rendering of a reactive server-morphable slot
|
||||
;; --------------------------------------------------------------------------
|
||||
;;
|
||||
;; (marsh :id "name" :tag "div" :transform fn children...)
|
||||
;; → <div data-sx-marsh="name">children</div>
|
||||
;;
|
||||
;; Like a lake but reactive: during morph, new content is parsed as SX and
|
||||
;; re-evaluated in the island's signal scope. Server renders children normally;
|
||||
;; the :transform is a client-only concern.
|
||||
|
||||
(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)
|
||||
;; Provide scope for spread emit!
|
||||
(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 ">"))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; render-html-island — SSR rendering of a reactive island
|
||||
;; --------------------------------------------------------------------------
|
||||
;;
|
||||
;; Renders the island body as static HTML wrapped in a container element
|
||||
;; with data-sx-island and data-sx-state attributes. The client hydrates
|
||||
;; this by finding these elements and re-rendering with reactive context.
|
||||
;;
|
||||
;; On the server, signal/deref/reset!/swap! are simple passthrough:
|
||||
;; (signal val) → returns val (no container needed server-side)
|
||||
;; (deref s) → returns s (signal values are plain values server-side)
|
||||
;; (reset! s v) → no-op
|
||||
;; (swap! s f) → no-op
|
||||
|
||||
(define render-html-island :effects [render]
|
||||
(fn ((island :as island) (args :as list) (env :as dict))
|
||||
;; Parse kwargs and children (same pattern as render-html-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 raw HTML
|
||||
(when (component-has-children? island)
|
||||
(env-bind! local "children"
|
||||
(make-raw-html (join "" (map (fn (c) (render-to-html c env)) children)))))
|
||||
|
||||
;; Render the island body as HTML
|
||||
(let ((body-html (render-to-html (component-body island) local))
|
||||
(state-sx (serialize-island-state kwargs)))
|
||||
;; Wrap in container with hydration attributes
|
||||
(str "<span data-sx-island=\"" (escape-attr island-name) "\""
|
||||
(if state-sx
|
||||
(str " data-sx-state=\"" (escape-attr state-sx) "\"")
|
||||
"")
|
||||
">"
|
||||
body-html
|
||||
"</span>"))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; serialize-island-state — serialize kwargs to SX for hydration
|
||||
;; --------------------------------------------------------------------------
|
||||
;;
|
||||
;; Uses the SX serializer (not JSON) so the client can parse with sx-parse.
|
||||
;; Handles all SX types natively: numbers, strings, booleans, nil, lists, dicts.
|
||||
|
||||
(define serialize-island-state :effects []
|
||||
(fn ((kwargs :as dict))
|
||||
(if (empty-dict? kwargs)
|
||||
nil
|
||||
(sx-serialize kwargs))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Platform interface — HTML adapter
|
||||
;; --------------------------------------------------------------------------
|
||||
;;
|
||||
;; Inherited from render.sx:
|
||||
;; escape-html, escape-attr, raw-html-content
|
||||
;;
|
||||
;; 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
|
||||
;;
|
||||
;; Raw HTML construction:
|
||||
;; (make-raw-html s) → wrap string as raw HTML (not double-escaped)
|
||||
;;
|
||||
;; Island state serialization:
|
||||
;; (sx-serialize val) → SX source string (from parser.sx)
|
||||
;; (empty-dict? d) → boolean
|
||||
;; (escape-attr s) → HTML attribute escape
|
||||
;;
|
||||
;; Iteration:
|
||||
;; (for-each-indexed fn coll) → call fn(index, item) for each element
|
||||
;; (map-indexed fn coll) → map fn(index, item) over each element
|
||||
;; --------------------------------------------------------------------------
|
||||
(define serialize-island-state :effects () (fn ((kwargs :as dict)) (if (empty-dict? kwargs) nil (sx-serialize kwargs))))
|
||||
|
||||
Reference in New Issue
Block a user