;; ========================================================================== ;; 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) ;; 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 (emit! "element-attrs" (spread-attrs expr)) "") ;; Everything else — evaluate first :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 (emit! "element-attrs" (spread-attrs val)) "") :else (escape-html (str val))))) ;; -------------------------------------------------------------------------- ;; Render-aware form classification ;; -------------------------------------------------------------------------- (define RENDER_HTML_FORMS (list "if" "when" "cond" "case" "let" "let*" "begin" "do" "define" "defcomp" "defisland" "defmacro" "defstyle" "defhandler" "deftype" "defeffect" "map" "map-indexed" "filter" "for-each" "scope" "provide")) (define render-html-form? :effects [] (fn ((name :as string)) (contains? RENDER_HTML_FORMS name))) ;; -------------------------------------------------------------------------- ;; render-list-to-html — dispatch on list head ;; -------------------------------------------------------------------------- (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)) ;; Raw HTML passthrough (= name "raw!") (join "" (map (fn (x) (str (trampoline (eval-expr x env)))) args)) ;; 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) ;; 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) ;; 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-set! 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-set! 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-set! 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)) (emitted "element-attrs")) (scope-pop! "element-attrs") (str "<" tag (render-attrs attrs) ">" content ""))))))) ;; -------------------------------------------------------------------------- ;; render-html-lake — SSR rendering of a server-morphable slot ;; -------------------------------------------------------------------------- ;; ;; (lake :id "name" children...) →
children
;; ;; 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)) (emitted "element-attrs")) (scope-pop! "element-attrs") (str "<" lake-tag (render-attrs lake-attrs) ">" content "")))))) ;; -------------------------------------------------------------------------- ;; render-html-marsh — SSR rendering of a reactive server-morphable slot ;; -------------------------------------------------------------------------- ;; ;; (marsh :id "name" :tag "div" :transform fn children...) ;; →
children
;; ;; 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)) (emitted "element-attrs")) (scope-pop! "element-attrs") (str "<" marsh-tag (render-attrs marsh-attrs) ">" content "")))))) ;; -------------------------------------------------------------------------- ;; 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-set! 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-set! 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 "" body-html "")))))) ;; -------------------------------------------------------------------------- ;; 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 ;; --------------------------------------------------------------------------