diff --git a/spec/harness.sx b/spec/harness.sx index f636579a..5628a2f0 100644 --- a/spec/harness.sx +++ b/spec/harness.sx @@ -1,3 +1,7 @@ +(define assert (fn (condition msg) (when (not condition) (error (or msg "Assertion failed"))))) + +(define assert= (fn (actual expected msg) (when (not (equal? actual expected)) (error (or msg (str "Expected " expected ", got " actual)))))) + (define default-platform {:current-user (fn () nil) :csrf-token (fn () "test-csrf-token") :app-url (fn (service &rest path) "/mock-app-url") :frag (fn (service comp &rest args) "") :sleep (fn (ms) nil) :local-storage-set (fn (key val) nil) :set-cookie (fn (name val &rest opts) nil) :url-for (fn (endpoint &rest args) "/mock-url") :create-element (fn (tag) nil) :request-path (fn () "/") :config (fn (key) nil) :set-attr (fn (el name val) nil) :set-text (fn (el text) nil) :remove-child (fn (parent child) nil) :fetch (fn (url &rest opts) {:status 200 :body "" :ok true}) :query (fn (service name &rest args) (list)) :add-class (fn (el cls) nil) :get-element (fn (id) nil) :now (fn () 0) :abort (fn (code) nil) :action (fn (service name &rest args) {:ok true}) :remove-class (fn (el cls) nil) :append-child (fn (parent child) nil) :request-arg (fn (name) nil) :emit-dom (fn (op &rest args) nil) :local-storage-get (fn (key) nil) :get-cookie (fn (name) nil)}) (define make-harness :effects () (fn (&key platform) (let ((merged (if (nil? platform) default-platform (merge default-platform platform)))) {:log (list) :platform merged :state {:cookies {} :storage {} :dom nil}}))) diff --git a/sx/sx/reactive-islands/demo.sx b/sx/sx/reactive-islands/demo.sx index 490adf8e..641b4bf3 100644 --- a/sx/sx/reactive-islands/demo.sx +++ b/sx/sx/reactive-islands/demo.sx @@ -2,7 +2,7 @@ (defcomp ~reactive-islands/demo/example-counter () (~docs/page :title "Signal + Computed + Effect" (p "A signal holds a value. A computed derives from it. Click the buttons — the counter and doubled value update instantly, no server round-trip.") (~reactive-islands/index/demo-counter :initial 0) (~docs/code :src (highlight "(defisland ~reactive-islands/demo/counter (&key initial)\n (let ((count (signal (or initial 0)))\n (doubled (computed (fn () (* 2 (deref count))))))\n (div :class \"...\"\n (button :on-click (fn (e) (swap! count dec)) \"−\")\n (span (deref count))\n (button :on-click (fn (e) (swap! count inc)) \"+\")\n (p \"doubled: \" (deref doubled)))))" "lisp")) (p (code "(deref count)") " in a text position creates a reactive text node. When " (code "count") " changes, " (em "only that text node") " updates. " (code "doubled") " recomputes automatically. No diffing."))) -(defcomp ~reactive-islands/demo/example-temperature () (~docs/page :title "Temperature Converter" (p "Two derived values from one signal. Click to change Celsius — Fahrenheit updates reactively.") (~reactive-islands/index/demo-temperature) (~docs/code :src (highlight "(defisland ~reactive-islands/demo/temperature ()\n (let ((celsius (signal 20)))\n (div :class \"...\"\n (button :on-click (fn (e) (swap! celsius (fn (c) (- c 5)))) \"−5\")\n (span (deref celsius))\n (button :on-click (fn (e) (swap! celsius (fn (c) (+ c 5)))) \"+5\")\n (span \"°C = \")\n (span (+ (* (deref celsius) 1.8) 32))\n (span \"°F\"))))" "lisp")) (p "The actual implementation uses " (code "computed") " for Fahrenheit: " (code "(computed (fn () (+ (* (deref celsius) 1.8) 32)))") ". The " (code "(deref fahrenheit)") " in the span creates a reactive text node that updates when celsius changes.") (~reactive-islands/test-runner :test-src (str "(defsuite \"temperature converter\"\n" " (deftest \"initial celsius is 20\"\n" " (let ((celsius (signal 20)))\n" " (assert-signal-value celsius 20)))\n" " (deftest \"computed fahrenheit derives from celsius\"\n" " (let ((celsius (signal 20))\n" " (fahrenheit (computed (fn () (+ (* (deref celsius) 1.8) 32)))))\n" " (assert-signal-value fahrenheit 68)\n" " (assert-computed-depends-on fahrenheit celsius)))\n" " (deftest \"+5 increments celsius\"\n" " (let ((celsius (signal 20))\n" " (btn (mock-element \"button\")))\n" " (mock-add-listener! btn \"click\"\n" " (fn (e) (swap! celsius (fn (c) (+ c 5)))))\n" " (simulate-click btn)\n" " (assert-signal-value celsius 25)))\n" " (deftest \"−5 decrements celsius\"\n" " (let ((celsius (signal 20))\n" " (btn (mock-element \"button\")))\n" " (mock-add-listener! btn \"click\"\n" " (fn (e) (swap! celsius (fn (c) (- c 5)))))\n" " (simulate-click btn)\n" " (assert-signal-value celsius 15)))\n" " (deftest \"fahrenheit updates on celsius change\"\n" " (let ((celsius (signal 20))\n" " (fahrenheit (computed (fn () (+ (* (deref celsius) 1.8) 32)))))\n" " (reset! celsius 0)\n" " (assert-signal-value fahrenheit 32)\n" " (reset! celsius 100)\n" " (assert-signal-value fahrenheit 212)))\n" " (deftest \"multiple clicks accumulate\"\n" " (let ((celsius (signal 20))\n" " (fahrenheit (computed (fn () (+ (* (deref celsius) 1.8) 32))))\n" " (btn (mock-element \"button\")))\n" " (mock-add-listener! btn \"click\"\n" " (fn (e) (swap! celsius (fn (c) (+ c 5)))))\n" " (simulate-click btn)\n" " (simulate-click btn)\n" " (simulate-click btn)\n" " (assert-signal-value celsius 35)\n" " (assert-signal-value fahrenheit 95))))")))) +(defcomp ~reactive-islands/demo/example-temperature () (~docs/page :title "Temperature Converter" (p "Two derived values from one signal. Click to change Celsius — Fahrenheit updates reactively.") (~reactive-islands/index/demo-temperature) (~docs/code :src (highlight "(defisland ~reactive-islands/demo/temperature ()\n (let ((celsius (signal 20)))\n (div :class \"...\"\n (button :on-click (fn (e) (swap! celsius (fn (c) (- c 5)))) \"−5\")\n (span (deref celsius))\n (button :on-click (fn (e) (swap! celsius (fn (c) (+ c 5)))) \"+5\")\n (span \"°C = \")\n (span (+ (* (deref celsius) 1.8) 32))\n (span \"°F\"))))" "lisp")) (p "The actual implementation uses " (code "computed") " for Fahrenheit: " (code "(computed (fn () (+ (* (deref celsius) 1.8) 32)))") ". The " (code "(deref fahrenheit)") " in the span creates a reactive text node that updates when celsius changes.") (div :class "mt-6" (~reactive-islands/test-runner-placeholder) (script :type "text/sx-test" :data-for "temperature" "(defsuite \"temperature converter\" (deftest \"initial celsius is 20\" (let ((celsius (signal 20))) (assert-signal-value celsius 20))) (deftest \"computed fahrenheit = celsius * 1.8 + 32\" (let ((celsius (signal 20)) (fahrenheit (computed (fn () (+ (* (deref celsius) 1.8) 32))))) (assert-signal-value fahrenheit 68) (assert-computed-depends-on fahrenheit celsius))) (deftest \"+5 increments celsius\" (let ((celsius (signal 20)) (btn (mock-element \"button\"))) (mock-add-listener! btn \"click\" (fn (e) (swap! celsius (fn (c) (+ c 5))))) (simulate-click btn) (assert-signal-value celsius 25))) (deftest \"fahrenheit updates on celsius change\" (let ((celsius (signal 20)) (fahrenheit (computed (fn () (+ (* (deref celsius) 1.8) 32))))) (reset! celsius 0) (assert-signal-value fahrenheit 32) (reset! celsius 100) (assert-signal-value fahrenheit 212))) (deftest \"multiple clicks accumulate\" (let ((celsius (signal 20)) (fahrenheit (computed (fn () (+ (* (deref celsius) 1.8) 32)))) (btn (mock-element \"button\"))) (mock-add-listener! btn \"click\" (fn (e) (swap! celsius (fn (c) (+ c 5))))) (simulate-click btn) (simulate-click btn) (simulate-click btn) (assert-signal-value celsius 35) (assert-signal-value fahrenheit 95))))")))) (defcomp ~reactive-islands/demo/example-stopwatch () (~docs/page :title "Effect + Cleanup: Stopwatch" (p "Effects can return cleanup functions. This stopwatch starts a " (code "set-interval") " — the cleanup clears it when the running signal toggles off.") (~reactive-islands/index/demo-stopwatch) (~docs/code :src (highlight "(defisland ~reactive-islands/demo/stopwatch ()\n (let ((running (signal false))\n (elapsed (signal 0))\n (time-text (create-text-node \"0.0s\"))\n (btn-text (create-text-node \"Start\")))\n ;; Timer: effect creates interval, cleanup clears it\n (effect (fn ()\n (when (deref running)\n (let ((id (set-interval (fn () (swap! elapsed inc)) 100)))\n (fn () (clear-interval id))))))\n ;; Display: updates text node when elapsed changes\n (effect (fn ()\n (let ((e (deref elapsed)))\n (dom-set-text-content time-text\n (str (floor (/ e 10)) \".\" (mod e 10) \"s\")))))\n ;; Button label\n (effect (fn ()\n (dom-set-text-content btn-text\n (if (deref running) \"Stop\" \"Start\"))))\n (div :class \"...\"\n (span time-text)\n (button :on-click (fn (e) (swap! running not)) btn-text)\n (button :on-click (fn (e)\n (reset! running false) (reset! elapsed 0)) \"Reset\"))))" "lisp")) (p "Three effects, each tracking different signals. The timer effect's cleanup fires before each re-run — toggling " (code "running") " off clears the interval. No hook rules: effects can appear anywhere, in any order."))) diff --git a/sx/sx/reactive-islands/test-runner.sx b/sx/sx/reactive-islands/test-runner.sx index f404a950..692c3b95 100644 --- a/sx/sx/reactive-islands/test-runner.sx +++ b/sx/sx/reactive-islands/test-runner.sx @@ -1,76 +1,3 @@ -;; ~reactive-islands/test-runner — inline test runner island -;; -;; Displays test results for a test suite. Runs tests on mount and -;; shows pass/fail with details. +(defcomp ~reactive-islands/test-runner-placeholder () (div :class "rounded border border-stone-200 bg-stone-50 p-4" :data-sx-island "reactive-islands/test-runner" (p :class "text-stone-400 text-sm italic" "Loading tests..."))) -(defisland ~reactive-islands/test-runner (&key test-src) - (let ((results (signal nil)) - (running (signal false))) - - (letrec - ((run-tests (fn () - (reset! running true) - (let ((parsed (sx-parse test-src)) - (test-results (list))) - ;; Walk parsed expressions looking for deftest/defsuite - (for-each (fn (expr) - (when (and (list? expr) (not (empty? expr)) - (= (type-of (first expr)) "symbol")) - (let ((head (symbol-name (first expr)))) - (cond - (= head "defsuite") - ;; Process each deftest in the suite - (for-each (fn (child) - (when (and (list? child) (not (empty? child)) - (= (type-of (first child)) "symbol") - (= (symbol-name (first child)) "deftest")) - (let ((test-name (nth child 1)) - (test-body (last child))) - (let ((result (try-test test-name test-body))) - (append! test-results result))))) - (slice expr 2)) - (= head "deftest") - (let ((test-name (nth expr 1)) - (test-body (last expr))) - (append! test-results (try-test test-name test-body))))))) - parsed) - (reset! results test-results) - (reset! running false)))) - - (try-test (fn (name body) - (let ((error-msg nil)) - ;; Evaluate the test body, catch assertion failures - (let ((ok (cek-try - (fn () (cek-eval (sx-serialize body)) true) - (fn (err) (set! error-msg (str err)) false)))) - {:name name :pass ok :error error-msg}))))) - - ;; Run on mount - (run-tests) - - (div :class "mt-6 rounded border border-stone-200 bg-stone-50 p-4" - (div :class "flex items-center justify-between mb-3" - (h4 :class "text-sm font-semibold text-stone-700" "Tests") - (button :class "px-2 py-1 text-xs rounded bg-stone-200 hover:bg-stone-300" - :on-click (fn (e) (run-tests)) - "Re-run")) - - (if (deref running) - (p :class "text-stone-400 text-sm italic" "Running...") - (if (nil? (deref results)) - (p :class "text-stone-400 text-sm italic" "No results") - (let ((r (deref results)) - (pass-count (len (filter (fn (t) (get t "pass")) r))) - (fail-count (len (filter (fn (t) (not (get t "pass"))) r)))) - (div :class "space-y-2" - (div :class "text-sm font-mono" - (span :class (if (= fail-count 0) "text-emerald-600" "text-red-600") - (str pass-count "/" (len r) " passed"))) - (map (fn (t) - (div :class "flex items-start gap-2 text-xs font-mono py-0.5" - (span :class (if (get t "pass") "text-emerald-500" "text-red-500") - (if (get t "pass") "✓" "✗")) - (span :class "text-stone-600" (get t "name")) - (when (get t "error") - (span :class "text-red-400 ml-2" (get t "error"))))) - r))))))))) +(defisland ~reactive-islands/test-runner () (let ((results (signal nil)) (running (signal false))) (letrec ((run-tests (fn () (reset! running true) (let ((script-el (dom-query "script[data-for]")) (test-results (list))) (when script-el (let ((test-src (host-get script-el "textContent")) (parsed (let ((raw (host-get script-el "textContent")) (decoded (host-call raw "replaceAll" """ "\""))) (sx-parse (host-call decoded "replaceAll" "&" "&"))))) (for-each (fn (expr) (when (and (list? expr) (not (empty? expr)) (= (type-of (first expr)) "symbol")) (let ((head (symbol-name (first expr)))) (cond (= head "defsuite") (for-each (fn (child) (when (and (list? child) (not (empty? child)) (= (type-of (first child)) "symbol") (= (symbol-name (first child)) "deftest")) (append! test-results (try-test (nth child 1) (last child))))) (slice expr 2)) (= head "deftest") (append! test-results (try-test (nth expr 1) (last expr))))))) parsed))) (reset! results test-results) (reset! running false)))) (try-test (fn (name body) (let ((result (cek-try (fn () (eval-expr body (global-env)) true) (fn (err) err)))) (if (= result true) {:pass true :error nil :name name} {:pass false :error (str result) :name name}))))) (run-tests) (div :class "rounded border border-stone-200 bg-stone-50 p-4" (div :class "flex items-center justify-between mb-3" (h4 :class "text-sm font-semibold text-stone-700" "Tests") (button :class "px-2 py-1 text-xs rounded bg-stone-200 hover:bg-stone-300 transition" :on-click (fn (e) (run-tests)) "Re-run")) (if (deref running) (p :class "text-stone-400 text-sm italic" "Running...") (if (nil? (deref results)) (p :class "text-stone-400 text-sm italic" "No test source found") (let ((r (deref results)) (pass-count (len (filter (fn (t) (get t "pass")) r))) (fail-count (len (filter (fn (t) (not (get t "pass"))) r)))) (div :class "space-y-2" (div :class "text-sm font-mono" (span :class (if (= fail-count 0) "text-emerald-600 font-semibold" "text-red-600 font-semibold") (str pass-count "/" (len r) " passed"))) (map (fn (t) (div :class "flex items-start gap-2 text-xs font-mono py-0.5" (span :class (if (get t "pass") "text-emerald-500" "text-red-500") (if (get t "pass") "✓" "✗")) (span :class "text-stone-600" (get t "name")) (when (get t "error") (span :class "text-red-400 ml-2" (get t "error"))))) r))))))))) diff --git a/web/adapter-html.sx b/web/adapter-html.sx index 18fdb7ad..f07bfa26 100644 --- a/web/adapter-html.sx +++ b/web/adapter-html.sx @@ -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 ""))))))) -;; -------------------------------------------------------------------------- -;; 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 "")))))) -(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 "")))))) - ;; 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 "" body-html "")))))) - ;; 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 - ""))))))) - - -;; -------------------------------------------------------------------------- -;; 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)) - (scope-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)) - (scope-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-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 "" - 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 -;; -------------------------------------------------------------------------- +(define serialize-island-state :effects () (fn ((kwargs :as dict)) (if (empty-dict? kwargs) nil (sx-serialize kwargs))))