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>
556 lines
22 KiB
Plaintext
556 lines
22 KiB
Plaintext
;; ==========================================================================
|
|
;; 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 — pass through as-is (parent element will merge attrs)
|
|
"spread" 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" 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" "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 (spreads filtered — no parent element)
|
|
(join "" (filter (fn (x) (not (spread? x)))
|
|
(map (fn (x) (render-value-to-html x env)) expr)))
|
|
(let ((name (symbol-name head))
|
|
(args (rest expr)))
|
|
(cond
|
|
;; Fragment (spreads filtered — no parent element)
|
|
(= name "<>")
|
|
(join "" (filter (fn (x) (not (spread? x)))
|
|
(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 (spread propagates). 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)
|
|
(let ((results (map (fn (i) (render-to-html (nth expr i) env))
|
|
(range 2 (len expr)))))
|
|
(join "" (filter (fn (r) (not (spread? r))) results)))))
|
|
|
|
;; 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)
|
|
(let ((results (map (fn (i) (render-to-html (nth expr i) local))
|
|
(range 2 (len expr)))))
|
|
(join "" (filter (fn (r) (not (spread? r))) results)))))
|
|
|
|
;; 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)
|
|
(let ((results (map (fn (i) (render-to-html (nth expr i) env))
|
|
(range 1 (len expr)))))
|
|
(join "" (filter (fn (r) (not (spread? r))) results))))
|
|
|
|
;; Definition forms — eval for side effects
|
|
(definition-form? name)
|
|
(do (trampoline (eval-expr expr env)) "")
|
|
|
|
;; map — spreads filtered (no parent element in list context)
|
|
(= name "map")
|
|
(let ((f (trampoline (eval-expr (nth expr 1) env)))
|
|
(coll (trampoline (eval-expr (nth expr 2) env))))
|
|
(join ""
|
|
(filter (fn (r) (not (spread? r)))
|
|
(map
|
|
(fn (item)
|
|
(if (lambda? f)
|
|
(render-lambda-html f (list item) env)
|
|
(render-to-html (apply f (list item)) env)))
|
|
coll))))
|
|
|
|
;; map-indexed — spreads filtered
|
|
(= name "map-indexed")
|
|
(let ((f (trampoline (eval-expr (nth expr 1) env)))
|
|
(coll (trampoline (eval-expr (nth expr 2) env))))
|
|
(join ""
|
|
(filter (fn (r) (not (spread? r)))
|
|
(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) — spreads filtered
|
|
(= name "for-each")
|
|
(let ((f (trampoline (eval-expr (nth expr 1) env)))
|
|
(coll (trampoline (eval-expr (nth expr 2) env))))
|
|
(join ""
|
|
(filter (fn (r) (not (spread? r)))
|
|
(map
|
|
(fn (item)
|
|
(if (lambda? f)
|
|
(render-lambda-html f (list item) env)
|
|
(render-to-html (apply f (list item)) env)))
|
|
coll))))
|
|
|
|
;; 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)))
|
|
(body-start 3)
|
|
(body-count (- (len expr) 3)))
|
|
(provide-push! prov-name prov-val)
|
|
(let ((result (if (= body-count 1)
|
|
(render-to-html (nth expr body-start) env)
|
|
(join "" (filter (fn (r) (not (spread? r)))
|
|
(map (fn (i) (render-to-html (nth expr i) env))
|
|
(range body-start (+ body-start body-count))))))))
|
|
(provide-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
|
|
;; Spread values are filtered out (no parent element to merge onto)
|
|
(when (component-has-children? comp)
|
|
(let ((parts (list)))
|
|
(for-each
|
|
(fn (c)
|
|
(let ((r (render-to-html c env)))
|
|
(when (not (spread? r))
|
|
(append! parts r))))
|
|
children)
|
|
(env-set! local "children"
|
|
(make-raw-html (join "" parts)))))
|
|
(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) " />")
|
|
;; Render children, collecting spreads and content separately
|
|
(let ((content-parts (list)))
|
|
(for-each
|
|
(fn (c)
|
|
(let ((result (render-to-html c env)))
|
|
(if (spread? result)
|
|
(merge-spread-attrs attrs (spread-attrs result))
|
|
(append! content-parts result))))
|
|
children)
|
|
(str "<" tag (render-attrs attrs) ">"
|
|
(join "" content-parts)
|
|
"</" 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)
|
|
;; Render children, handling spreads
|
|
(let ((lake-attrs (dict "data-sx-lake" (or lake-id "")))
|
|
(content-parts (list)))
|
|
(for-each
|
|
(fn (c)
|
|
(let ((result (render-to-html c env)))
|
|
(if (spread? result)
|
|
(merge-spread-attrs lake-attrs (spread-attrs result))
|
|
(append! content-parts result))))
|
|
children)
|
|
(str "<" lake-tag (render-attrs lake-attrs) ">"
|
|
(join "" content-parts)
|
|
"</" 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)
|
|
;; Render children, handling spreads
|
|
(let ((marsh-attrs (dict "data-sx-marsh" (or marsh-id "")))
|
|
(content-parts (list)))
|
|
(for-each
|
|
(fn (c)
|
|
(let ((result (render-to-html c env)))
|
|
(if (spread? result)
|
|
(merge-spread-attrs marsh-attrs (spread-attrs result))
|
|
(append! content-parts result))))
|
|
children)
|
|
(str "<" marsh-tag (render-attrs marsh-attrs) ">"
|
|
(join "" content-parts)
|
|
"</" 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-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
|
|
;; Spread values filtered out (no parent element)
|
|
(when (component-has-children? island)
|
|
(let ((parts (list)))
|
|
(for-each
|
|
(fn (c)
|
|
(let ((r (render-to-html c env)))
|
|
(when (not (spread? r))
|
|
(append! parts r))))
|
|
children)
|
|
(env-set! local "children"
|
|
(make-raw-html (join "" parts)))))
|
|
|
|
;; 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
|
|
;; --------------------------------------------------------------------------
|