coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Implement sx-swap pure tree rewriting and fix handler test infrastructure

Browse Source 
Write lib/sx-swap.sx — string-level SX scanner that finds elements by :id
and applies swap operations (innerHTML, outerHTML, beforeend, afterbegin,
beforebegin, afterend, delete, none). Includes OOB extraction via
find-oob-elements/strip-oob/apply-response for out-of-band targeted swaps.

Fix &rest varargs bug in test-handlers.sx helper mock — fn doesn't support
&rest, so change to positional (name a1 a2) with nil defaults. Fix into
branch, add run-handler sx-expr unwrapping.

Add missing primitives to run_tests.ml: scope-peek, callable?, make-sx-expr,
sx-expr-source, sx-expr?, spread?, call-lambda. These unblock aser-based
handler evaluation in tests.

Add algebraic integration tests (test-swap-integration.sx) demonstrating the
sx1 ⊕(mode,target) sx2 = sx3 pattern with real handler execution.

1219 → 1330 passing tests (+111).

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-01 18:00:51 +00:00
parent f5f58ea47e
commit aa508bad77
5 changed files with 1445 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

131
hosts/ocaml/bin/run_tests.ml
View File

@@ -319,6 +319,12 @@ let make_test_env () =
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
(match stack with _ :: rest -> Hashtbl.replace _scope_stacks name rest | [] -> ()); Nil
| _ -> Nil);
bind "scope-peek" (fun args ->
match args with
| [String name] ->
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
(match stack with v :: _ -> v | [] -> Nil)
| _ -> Nil);
bind "scope-emit!" (fun args ->
match args with
| [String name; value] ->
@@ -385,10 +391,89 @@ let make_test_env () =
eval_expr m.m_body (Env local)
| _ -> raise (Eval_error "expand-macro: expected (macro args env)"));
bind "callable?" (fun args ->
match args with
| [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true
| _ -> Bool false);
bind "make-sx-expr" (fun args -> match args with [String s] -> SxExpr s | _ -> raise (Eval_error "make-sx-expr: expected string"));
bind "sx-expr-source" (fun args -> match args with [SxExpr s] -> String s | [String s] -> String s | _ -> raise (Eval_error "sx-expr-source: expected sx-expr or string"));
bind "sx-expr?" (fun args -> match args with [SxExpr _] -> Bool true | _ -> Bool false);
bind "spread?" (fun args -> match args with [Spread _] -> Bool true | _ -> Bool false);
bind "call-lambda" (fun args ->
match args with
| [Lambda _ as f; (List a | ListRef { contents = a })] ->
let l = match f with Lambda l -> l | _ -> assert false in
let local = Sx_types.env_extend l.l_closure in
let rec bind_ps ps as' = match ps, as' with
| [], _ -> () | p :: pr, a :: ar -> ignore (Sx_types.env_bind local p a); bind_ps pr ar
| p :: pr, [] -> ignore (Sx_types.env_bind local p Nil); bind_ps pr [] in
bind_ps l.l_params a;
eval_expr l.l_body (Env local)
| [Lambda _ as f; (List a | ListRef { contents = a }); Env e] ->
let l = match f with Lambda l -> l | _ -> assert false in
let local = Sx_types.env_merge l.l_closure e in
let rec bind_ps ps as' = match ps, as' with
| [], _ -> () | p :: pr, a :: ar -> ignore (Sx_types.env_bind local p a); bind_ps pr ar
| p :: pr, [] -> ignore (Sx_types.env_bind local p Nil); bind_ps pr [] in
bind_ps l.l_params a;
eval_expr l.l_body (Env local)
| _ -> raise (Eval_error "call-lambda: expected (fn args env?)"));
(* Declarative type/effect forms — no-ops at runtime *)
bind "deftype" (fun _args -> Nil);
bind "defeffect" (fun _args -> Nil);
(* defhandler — register handler as handler:name in eval env.
Mirrors sx_server.ml's defhandler special form. *)
ignore (Sx_ref.register_special_form (String "defhandler") (NativeFn ("defhandler", fun sf_args ->
let raw_args, eval_env = match sf_args with
| [List a; Env e] | [ListRef { contents = a }; Env e] -> (a, e)
| _ -> ([], env) in
match raw_args with
| name_sym :: rest ->
let name = match name_sym with Symbol s -> s | String s -> s | _ -> Sx_types.inspect name_sym in
let rec parse_opts acc = function
| Keyword k :: v :: rest -> Hashtbl.replace acc k v; parse_opts acc rest
| rest -> (acc, rest) in
let opts = Hashtbl.create 4 in
let (_, remaining) = parse_opts opts rest in
let _params, body = match remaining with
| List p :: b :: _ -> (p, b) | List _p :: [] -> (_p, Nil) | _ -> ([], Nil) in
let hdef = Hashtbl.create 8 in
Hashtbl.replace hdef "__type" (String "handler");
Hashtbl.replace hdef "name" (String name);
Hashtbl.replace hdef "body" body;
Hashtbl.replace hdef "closure" (Env eval_env);
Hashtbl.replace hdef "method" (match Hashtbl.find_opt opts "method" with
| Some (Keyword m) -> String m | Some v -> v | None -> String "get");
ignore (Sx_types.env_bind eval_env ("handler:" ^ name) (Dict hdef));
Dict hdef
| _ -> Nil)));
(* defisland — register island component. Stub: creates a component record. *)
ignore (Sx_ref.register_special_form (String "defisland") (NativeFn ("defisland", fun sf_args ->
let raw_args, eval_env = match sf_args with
| [List a; Env e] | [ListRef { contents = a }; Env e] -> (a, e)
| _ -> ([], env) in
match raw_args with
| name_sym :: rest ->
let name = match name_sym with Symbol s -> s | String s -> s | _ -> Sx_types.inspect name_sym in
let short_name = if String.length name > 1 && name.[0] = '~' then String.sub name 1 (String.length name - 1) else name in
let params, body = match rest with
| List p :: b :: _ -> (p, b) | List p :: [] -> (p, Nil) | _ -> ([], Nil) in
let param_names = List.filter_map (fun p ->
match p with Symbol s -> Some s | _ -> None) params in
let has_children = List.exists (fun p ->
match p with Symbol "&rest" -> true | _ -> false) params in
let island = Island {
i_name = short_name; i_params = param_names;
i_has_children = has_children;
i_body = body; i_closure = eval_env; i_file = None;
} in
ignore (Sx_types.env_bind eval_env name island);
island
| _ -> Nil)));
(* --- Primitives for canonical.sx / content tests --- *)
bind "contains-char?" (fun args ->
match args with
@@ -854,6 +939,11 @@ let run_spec_tests env test_files =
(* Render adapter for test-render-html.sx *)
load_module "render.sx" spec_dir;
load_module "adapter-html.sx" web_dir;
load_module "adapter-sx.sx" web_dir;
(* Web modules for web/tests/ *)
load_module "engine.sx" web_dir;
load_module "page-helpers.sx" web_dir;
load_module "request-handler.sx" web_dir;
(* Library modules for lib/tests/ *)
load_module "bytecode.sx" lib_dir;
load_module "compiler.sx" lib_dir;
@@ -863,9 +953,33 @@ let run_spec_tests env test_files =
load_module "freeze.sx" lib_dir;
load_module "content.sx" lib_dir;
load_module "types.sx" lib_dir;
load_module "sx-swap.sx" lib_dir;
(* SX docs site: components, handlers, demos *)
let sx_comp_dir = Filename.concat project_dir "sx/sxc" in
let sx_sx_dir = Filename.concat project_dir "sx/sx" in
let sx_handlers_dir = Filename.concat project_dir "sx/sx/handlers" in
let sx_islands_dir = Filename.concat project_dir "sx/sx/reactive-islands" in
let sx_geo_dir = Filename.concat project_dir "sx/sx/geography" in
(* Components + handlers *)
load_module "examples.sx" sx_comp_dir;
load_module "docs.sx" sx_sx_dir;
load_module "examples.sx" sx_handlers_dir;
load_module "ref-api.sx" sx_handlers_dir;
load_module "reactive-api.sx" sx_handlers_dir;
(* Server-rendered demos *)
load_module "scopes.sx" sx_sx_dir;
load_module "provide.sx" sx_sx_dir;
load_module "spreads.sx" sx_sx_dir;
(* Island definitions *)
load_module "index.sx" sx_islands_dir;
load_module "demo.sx" sx_islands_dir;
load_module "marshes.sx" sx_islands_dir;
load_module "cek.sx" sx_geo_dir;
load_module "reactive-runtime.sx" sx_sx_dir;
(* Determine test files — scan spec/tests/ and lib/tests/ *)
(* Determine test files — scan spec/tests/, lib/tests/, web/tests/ *)
let lib_tests_dir = Filename.concat project_dir "lib/tests" in
let web_tests_dir = Filename.concat project_dir "web/tests" in
let files = if test_files = [] then begin
(* Spec tests (core language — always run) *)
let spec_entries = Sys.readdir spec_tests_dir in
@@ -878,15 +992,28 @@ let run_spec_tests env test_files =
f <> "test-framework.sx")
|> List.map (fun f -> Filename.concat spec_tests_dir f)
in
spec_files
(* Web tests (orchestration, handlers) *)
let web_files = if Sys.file_exists web_tests_dir then begin
let entries = Sys.readdir web_tests_dir in
Array.sort String.compare entries;
Array.to_list entries
|> List.filter (fun f ->
String.length f > 5 &&
String.sub f 0 5 = "test-" &&
Filename.check_suffix f ".sx")
|> List.map (fun f -> Filename.concat web_tests_dir f)
end else [] in
spec_files @ web_files
end else
(* Specific test files — search all test dirs *)
List.map (fun name ->
let name = if Filename.check_suffix name ".sx" then name else name ^ ".sx" in
let spec_path = Filename.concat spec_tests_dir name in
let lib_path = Filename.concat lib_tests_dir name in
let web_path = Filename.concat web_tests_dir name in
if Sys.file_exists spec_path then spec_path
else if Sys.file_exists lib_path then lib_path
else if Sys.file_exists web_path then web_path
else Filename.concat spec_tests_dir name (* will fail with "not found" *)
) test_files
in

300
lib/sx-swap.sx Normal file
View File

@@ -0,0 +1,300 @@
(define
_skip-string
(fn
(src i)
(if
(>= i (len src))
i
(let
((ch (nth src i)))
(cond
(= ch "\\")
(_skip-string src (+ i 2))
(= ch "\"")
(+ i 1)
:else (_skip-string src (+ i 1)))))))
(define
_find-close
(fn
(src i depth in-str)
(if
(>= i (len src))
-1
(let
((ch (nth src i)))
(cond
in-str
(cond
(= ch "\\")
(_find-close src (+ i 2) depth true)
(= ch "\"")
(_find-close src (+ i 1) depth false)
:else (_find-close src (+ i 1) depth true))
(= ch "\"")
(_find-close src (+ i 1) depth true)
(= ch "(")
(_find-close src (+ i 1) (+ depth 1) false)
(= ch ")")
(if (= depth 1) i (_find-close src (+ i 1) (- depth 1) false))
:else (_find-close src (+ i 1) depth false))))))
(define
_skip-ws
(fn
(src i)
(if
(>= i (len src))
i
(let
((ch (nth src i)))
(if
(or (= ch " ") (= ch "\n") (= ch "\t") (= ch "\r"))
(_skip-ws src (+ i 1))
i)))))
(define
_skip-token
(fn
(src i)
(if
(>= i (len src))
i
(let
((ch (nth src i)))
(if
(or
(= ch " ")
(= ch "\n")
(= ch "\t")
(= ch "\r")
(= ch "(")
(= ch ")")
(= ch "\""))
i
(_skip-token src (+ i 1)))))))
(define
_skip-value
(fn
(src i)
(if
(>= i (len src))
i
(let
((ch (nth src i)))
(cond
(= ch "\"")
(_skip-string src (+ i 1))
(= ch "(")
(let
((close (_find-close src (+ i 1) 1 false)))
(if (= close -1) (len src) (+ close 1)))
:else (_skip-token src i))))))
(define
_find-children-start
(fn
(src elem-start elem-end)
(let
((after-open (+ elem-start 1)))
(let
((after-tag (_skip-token src (_skip-ws src after-open))))
(define
_skip-attrs
(fn
(j)
(let
((pos (_skip-ws src j)))
(if
(>= pos elem-end)
pos
(if
(= (nth src pos) ":")
(let
((after-kw (_skip-token src pos)))
(_skip-attrs (_skip-value src (_skip-ws src after-kw))))
pos)))))
(_skip-attrs after-tag)))))
(define
_scan-back
(fn
(src i)
(if (< i 0) -1 (if (= (nth src i) "(") i (_scan-back src (- i 1))))))
(define
find-element-by-id
(fn
(src target-id)
(let
((pattern (str ":id \"" target-id "\"")))
(let
((pos (index-of src pattern)))
(if
(= pos -1)
nil
(let
((elem-start (_scan-back src (- pos 1))))
(if
(= elem-start -1)
nil
(let
((elem-end (_find-close src (+ elem-start 1) 1 false)))
(if
(= elem-end -1)
nil
(let
((cs (_find-children-start src elem-start elem-end)))
{:end elem-end :start elem-start :children-start cs}))))))))))
(define
sx-swap
(fn
(src mode target-id new-content)
(let
((info (find-element-by-id src target-id)))
(if
(nil? info)
src
(let
((s (get info "start"))
(e (get info "end"))
(cs (get info "children-start")))
(case
mode
"innerHTML"
(str (slice src 0 cs) new-content (slice src e (len src)))
"outerHTML"
(str (slice src 0 s) new-content (slice src (+ e 1) (len src)))
"beforeend"
(str (slice src 0 e) " " new-content (slice src e (len src)))
"afterbegin"
(str (slice src 0 cs) new-content " " (slice src cs (len src)))
"beforebegin"
(str (slice src 0 s) new-content (slice src s (len src)))
"afterend"
(str
(slice src 0 (+ e 1))
new-content
(slice src (+ e 1) (len src)))
"delete"
(str (slice src 0 s) (slice src (+ e 1) (len src)))
"none"
src
:else src))))))
(define
_extract-attr-value
(fn
(src keyword-end)
(let
((val-start (_skip-ws src keyword-end)))
(if
(= (nth src val-start) "\"")
(let
((str-end (_skip-string src (+ val-start 1))))
(slice src (+ val-start 1) (- str-end 1)))
(let
((tok-end (_skip-token src val-start)))
(slice src val-start tok-end))))))
(define
find-oob-elements
(fn
(src)
(define
_scan
(fn
(from results)
(let
((rel-pos (index-of (slice src from (len src)) ":sx-swap-oob")))
(if
(= rel-pos -1)
results
(let
((abs-pos (+ from rel-pos)))
(let
((mode (_extract-attr-value src (+ abs-pos 12))))
(let
((elem-start (_scan-back src (- abs-pos 1))))
(if
(= elem-start -1)
results
(let
((elem-end (_find-close src (+ elem-start 1) 1 false)))
(if
(= elem-end -1)
results
(let
((id-pattern ":id \""))
(let
((id-pos (index-of (slice src elem-start (+ elem-end 1)) id-pattern)))
(if
(= id-pos -1)
(_scan (+ elem-end 1) results)
(let
((id-abs (+ elem-start id-pos)))
(let
((id-val (_extract-attr-value src (+ id-abs 3))))
(let
((cs (_find-children-start src elem-start elem-end)))
(let
((children-str (slice src cs elem-end)))
(_scan
(+ elem-end 1)
(append results (list {:end elem-end :mode mode :content children-str :start elem-start :id id-val}))))))))))))))))))))
(_scan 0 (list))))
(define
strip-oob
(fn
(src oob-list)
(if
(empty? oob-list)
src
(let
((sorted (reverse oob-list)))
(define
_strip
(fn
(s items)
(if
(empty? items)
s
(let
((item (first items)))
(let
((before (slice s 0 (get item "start")))
(after (slice s (+ (get item "end") 1) (len s))))
(_strip (str before after) (rest items)))))))
(_strip src sorted)))))
(define
apply-response
(fn
(page response primary-mode primary-target)
(let
((oobs (find-oob-elements response)))
(let
((main-content (strip-oob response oobs)))
(let
((result (sx-swap page primary-mode primary-target main-content)))
(do
(define
_apply-oobs
(fn
(page-acc items)
(if
(empty? items)
page-acc
(let
((oob (first items)))
(_apply-oobs
(sx-swap
page-acc
(get oob "mode")
(get oob "id")
(get oob "content"))
(rest items))))))
(_apply-oobs result oobs)))))))

131
spec/tests/test-sx-swap.sx Normal file
View File

@@ -0,0 +1,131 @@
(defsuite
"sx-swap:innerHTML"
(deftest
"replaces children of target"
(let
((result (sx-swap "(div :id \"t\" (p \"old\"))" "innerHTML" "t" "(p \"new\")")))
(assert-equal result "(div :id \"t\" (p \"new\"))")))
(deftest
"replaces multiple children"
(let
((result (sx-swap "(div :id \"t\" (p \"a\") (p \"b\"))" "innerHTML" "t" "(span \"x\")")))
(assert-equal result "(div :id \"t\" (span \"x\"))")))
(deftest
"handles nested target"
(let
((result (sx-swap "(main (div :id \"t\" (p \"old\")))" "innerHTML" "t" "(p \"new\")")))
(assert-equal result "(main (div :id \"t\" (p \"new\")))")))
(deftest
"preserves attrs"
(let
((result (sx-swap "(div :id \"t\" :class \"box\" (p \"old\"))" "innerHTML" "t" "(p \"new\")")))
(assert-equal result "(div :id \"t\" :class \"box\" (p \"new\"))"))))
(defsuite
"sx-swap:outerHTML"
(deftest
"replaces entire element"
(let
((result (sx-swap "(main (div :id \"t\" (p \"old\")) (footer \"f\"))" "outerHTML" "t" "(section \"new\")")))
(assert-equal result "(main (section \"new\") (footer \"f\"))")))
(deftest
"replaces at root"
(let
((result (sx-swap "(div :id \"t\" (p \"old\"))" "outerHTML" "t" "(span \"new\")")))
(assert-equal result "(span \"new\")"))))
(defsuite
"sx-swap:beforeend"
(deftest
"appends to children"
(let
((result (sx-swap "(ul :id \"t\" (li \"a\"))" "beforeend" "t" "(li \"b\")")))
(assert-equal result "(ul :id \"t\" (li \"a\") (li \"b\"))")))
(deftest
"appends to empty element"
(let
((result (sx-swap "(div :id \"t\")" "beforeend" "t" "(p \"new\")")))
(assert-equal result "(div :id \"t\" (p \"new\"))"))))
(defsuite
"sx-swap:afterbegin"
(deftest
"prepends to children"
(let
((result (sx-swap "(ul :id \"t\" (li \"b\"))" "afterbegin" "t" "(li \"a\")")))
(assert-equal result "(ul :id \"t\" (li \"a\") (li \"b\"))"))))
(defsuite
"sx-swap:beforebegin"
(deftest
"inserts before element"
(let
((result (sx-swap "(div (p :id \"t\" \"x\"))" "beforebegin" "t" "(hr)")))
(assert-equal result "(div (hr)(p :id \"t\" \"x\"))"))))
(defsuite
"sx-swap:afterend"
(deftest
"inserts after element"
(let
((result (sx-swap "(div (p :id \"t\" \"x\") (span \"y\"))" "afterend" "t" "(hr)")))
(assert-equal result "(div (p :id \"t\" \"x\")(hr) (span \"y\"))"))))
(defsuite
"sx-swap:delete"
(deftest
"removes element"
(let
((result (sx-swap "(div (p :id \"t\" \"bye\") (p \"stay\"))" "delete" "t" "")))
(assert-true (contains? result "stay"))
(assert-false (contains? result "bye")))))
(defsuite
"sx-swap:none"
(deftest
"returns unchanged"
(let
((page "(div :id \"t\" (p \"x\"))"))
(assert-equal (sx-swap page "none" "t" "(p \"y\")") page))))
(defsuite
"sx-swap:missing-target"
(deftest
"returns unchanged when id not found"
(let
((page "(div :id \"other\" (p \"x\"))"))
(assert-equal (sx-swap page "innerHTML" "missing" "(p \"y\")") page))))
(defsuite
"sx-swap:oob"
(deftest
"finds oob elements"
(let
((src "(<> (p \"main\") (div :id \"oob-t\" :sx-swap-oob \"innerHTML\" (p \"oob\")))"))
(let
((oobs (find-oob-elements src)))
(assert-equal (len oobs) 1)
(assert-equal (get (first oobs) "id") "oob-t")
(assert-equal (get (first oobs) "mode") "innerHTML"))))
(deftest
"strips oob from response"
(let
((src "(<> (p \"main\") (div :id \"oob-t\" :sx-swap-oob \"innerHTML\" (p \"oob\")))"))
(let
((oobs (find-oob-elements src)))
(let
((main (strip-oob src oobs)))
(assert-true (contains? main "main"))
(assert-false (contains? main "oob-t"))))))
(deftest
"full pipeline applies primary + oob"
(let
((page "(div (div :id \"a\" (p \"A old\")) (div :id \"b\" (p \"B old\")))")
(response
"(<> (p \"A new\") (div :id \"b\" :sx-swap-oob \"innerHTML\" (p \"B new\")))"))
(let
((result (apply-response page response "innerHTML" "a")))
(assert-true (contains? result "A new"))
(assert-true (contains? result "B new"))
(assert-false (contains? result "A old"))
(assert-false (contains? result "B old"))))))

681
web/tests/test-handlers.sx Normal file
View File

@@ -0,0 +1,681 @@
(define _mock-form (dict))
(define _mock-args (dict))
(define _mock-state (dict))
(define _mock-body "")
(define _mock-content-type "")
(define _mock-headers (dict))
(define _mock-now "12:00:00")
(define
reset-mocks!
(fn
()
(do
(set! _mock-form (dict))
(set! _mock-args (dict))
(set! _mock-state (dict))
(set! _mock-body "")
(set! _mock-content-type "")
(set! _mock-headers (dict)))))
(define
helper
(fn
(name a1 a2)
(cond
(= name "request-form")
(let
((key (or a1 "")) (default (if (nil? a2) "" a2)))
(let ((val (get _mock-form key))) (if (nil? val) default val)))
(= name "request-arg")
(let
((key (or a1 "")) (default a2))
(let ((val (get _mock-args key))) (if (nil? val) default val)))
(= name "state-get")
(let
((key (or a1 "")) (default a2))
(let ((val (get _mock-state key))) (if (nil? val) default val)))
(= name "state-set!")
(do (set! _mock-state (assoc _mock-state a1 a2)) nil)
(= name "now")
(if (nil? a1) _mock-now _mock-now)
(= name "component-source")
(str "(defcomp " a1 " () (div))")
(= name "request-json")
_mock-body
(= name "request-content-type")
_mock-content-type
(= name "request-form-list")
(or (get _mock-form a1) (list))
(= name "request-args-all")
_mock-args
(= name "request-headers-all")
_mock-headers
(= name "request-form-all")
_mock-form
(= name "request-header")
(or (get _mock-headers a1) a2)
(= name "request-file-name")
(or (get _mock-form a1) "")
(= name "into")
(let
((coll (if (nil? a2) a1 a2)))
(if
(dict? coll)
(map (fn (key) (list key (get coll key))) (keys coll))
(if (nil? coll) (list) coll)))
:else nil)))
(define sleep (fn (ms) nil))
(define set-response-status (fn (code) nil))
(define json-encode (fn (val) (inspect val)))
(define
run-handler
(fn
(hdef)
(let
((result (aser (get hdef "body") (get hdef "closure"))))
(if
(sx-expr? result)
(sx-expr-source result)
(if (string? result) result (str result))))))
(defsuite
"example:click-to-load"
(deftest
"returns content with timestamp"
(reset-mocks!)
(let
((result (run-handler handler:ex-click)))
(assert-true (contains? result "Content loaded!"))))
(deftest
"includes mock time"
(reset-mocks!)
(let
((result (run-handler handler:ex-click)))
(assert-true (contains? result _mock-now))))
(deftest
"includes OOB code panel"
(reset-mocks!)
(let
((result (run-handler handler:ex-click)))
(assert-true (contains? result "click-comp")))))
(defsuite
"example:form-submission"
(deftest
"greets by name"
(reset-mocks!)
(set! _mock-form {:name "Alice"})
(let
((result (run-handler handler:ex-form)))
(assert-true (contains? result "Alice"))))
(deftest
"greets stranger when empty"
(reset-mocks!)
(set! _mock-form {:name ""})
(let
((result (run-handler handler:ex-form)))
(assert-true (contains? result "stranger"))))
(deftest
"includes wire format OOB"
(reset-mocks!)
(set! _mock-form {:name "Bob"})
(let
((result (run-handler handler:ex-form)))
(assert-true (contains? result "form-wire"))))
(deftest
"wire shows component call with name"
(reset-mocks!)
(set! _mock-form {:name "Bob"})
(let
((result (run-handler handler:ex-form)))
(assert-true (contains? result "Bob")))))
(defsuite
"example:polling"
(deftest
"increments counter from zero"
(reset-mocks!)
(run-handler handler:ex-poll)
(assert-equal 1 (get _mock-state "ex-poll-n")))
(deftest
"increments counter on second call"
(reset-mocks!)
(run-handler handler:ex-poll)
(run-handler handler:ex-poll)
(assert-equal 2 (get _mock-state "ex-poll-n")))
(deftest
"returns timestamp"
(reset-mocks!)
(let
((result (run-handler handler:ex-poll)))
(assert-true (contains? result _mock-now))))
(deftest
"returns counter value"
(reset-mocks!)
(run-handler handler:ex-poll)
(let
((result (run-handler handler:ex-poll)))
(assert-true (contains? result "2")))))
(defsuite
"example:delete-row"
(deftest
"returns OOB code panel"
(reset-mocks!)
(let
((result (run-handler handler:ex-delete)))
(assert-true (string? result))))
(deftest
"is valid SX"
(reset-mocks!)
(let
((result (run-handler handler:ex-delete)))
(assert-true (> (len result) 0)))))
(defsuite
"example:inline-edit"
(deftest
"edit-form returns current value"
(reset-mocks!)
(set! _mock-args {:value "hello"})
(let
((result (run-handler handler:ex-edit-form)))
(assert-true (contains? result "hello"))))
(deftest
"edit-save returns new value"
(reset-mocks!)
(set! _mock-form {:value "updated"})
(let
((result (run-handler handler:ex-edit-save)))
(assert-true (contains? result "updated"))))
(deftest
"edit-cancel restores original"
(reset-mocks!)
(set! _mock-args {:value "original"})
(let
((result (run-handler handler:ex-edit-cancel)))
(assert-true (contains? result "original"))))
(deftest
"full cycle: edit → save → cancel"
(reset-mocks!)
(set! _mock-args {:value "v1"})
(let
((edit (run-handler handler:ex-edit-form)))
(do
(assert-true (contains? edit "v1"))
(set! _mock-form {:value "v2"})
(let
((saved (run-handler handler:ex-edit-save)))
(do
(assert-true (contains? saved "v2"))
(set! _mock-args {:value "v1"})
(let
((cancelled (run-handler handler:ex-edit-cancel)))
(assert-true (contains? cancelled "v1")))))))))
(defsuite
"example:oob-updates"
(deftest
"returns timestamp"
(reset-mocks!)
(let
((result (run-handler handler:ex-oob)))
(assert-true (contains? result _mock-now))))
(deftest
"includes OOB swap target"
(reset-mocks!)
(let
((result (run-handler handler:ex-oob)))
(assert-true (contains? result "sx-swap-oob")))))
(defsuite
"example:lazy-load"
(deftest
"returns timestamp"
(reset-mocks!)
(let
((result (run-handler handler:ex-lazy)))
(assert-true (contains? result _mock-now))))
(deftest
"includes content message"
(reset-mocks!)
(let
((result (run-handler handler:ex-lazy)))
(assert-true (contains? result "page render")))))
(defsuite
"example:infinite-scroll"
(deftest
"page 2 returns items"
(reset-mocks!)
(set! _mock-args {:page "2"})
(let
((result (run-handler handler:ex-scroll)))
(assert-true (> (len result) 50))))
(deftest
"page 10 shows all loaded"
(reset-mocks!)
(set! _mock-args {:page "10"})
(let
((result (run-handler handler:ex-scroll)))
(assert-true (contains? result "loaded")))))
(defsuite
"example:progress-bar"
(deftest
"start creates job counter"
(reset-mocks!)
(run-handler handler:ex-progress-start)
(assert-equal 1 (get _mock-state "ex-job-counter")))
(deftest
"start initializes job at 0"
(reset-mocks!)
(run-handler handler:ex-progress-start)
(assert-equal 0 (get _mock-state "ex-job-1")))
(deftest
"status increments progress"
(reset-mocks!)
(set! _mock-state (assoc _mock-state "ex-job-1" 50))
(set! _mock-args {:job "1"})
(run-handler handler:ex-progress-status)
(assert-true (> (get _mock-state "ex-job-1") 50)))
(deftest
"full cycle: start → poll status"
(reset-mocks!)
(run-handler handler:ex-progress-start)
(set! _mock-args {:job "1"})
(run-handler handler:ex-progress-status)
(assert-true (> (get _mock-state "ex-job-1") 0))))
(defsuite
"example:search"
(deftest
"finds Python"
(reset-mocks!)
(set! _mock-args {:q "python"})
(let
((result (run-handler handler:ex-search)))
(assert-true (contains? result "Python"))))
(deftest
"finds multiple matches"
(reset-mocks!)
(set! _mock-args {:q "java"})
(let
((result (run-handler handler:ex-search)))
(assert-true (contains? result "Java"))))
(deftest
"empty query returns prompt"
(reset-mocks!)
(set! _mock-args {:q ""})
(let
((result (run-handler handler:ex-search)))
(assert-true (contains? result "type to search"))))
(deftest
"no match returns empty"
(reset-mocks!)
(set! _mock-args {:q "zzzznothing"})
(let
((result (run-handler handler:ex-search)))
(assert-true (not (contains? result "Python"))))))
(defsuite
"example:validation"
(deftest
"rejects empty"
(reset-mocks!)
(set! _mock-args {:email ""})
(let
((result (run-handler handler:ex-validate)))
(assert-true (contains? result "required"))))
(deftest
"rejects no @"
(reset-mocks!)
(set! _mock-args {:email "bad"})
(let
((result (run-handler handler:ex-validate)))
(assert-true (contains? result "@"))))
(deftest
"rejects taken email"
(reset-mocks!)
(set! _mock-args {:email "alice@example.com"})
(let
((result (run-handler handler:ex-validate)))
(assert-true (contains? result "taken"))))
(deftest
"accepts valid email"
(reset-mocks!)
(set! _mock-args {:email "new@example.com"})
(let
((result (run-handler handler:ex-validate)))
(assert-true (contains? result "available"))))
(deftest
"submit with valid email succeeds"
(reset-mocks!)
(set! _mock-form {:email "ok@test.com"})
(let
((result (run-handler handler:ex-validate-submit)))
(assert-true (contains? result "ok@test.com")))))
(defsuite
"example:dependent-select"
(deftest
"returns options for frontend"
(reset-mocks!)
(set! _mock-args {:category "frontend"})
(let
((result (run-handler handler:ex-values)))
(assert-true (contains? result "option"))))
(deftest
"empty category returns empty"
(reset-mocks!)
(set! _mock-args {:category ""})
(let
((result (run-handler handler:ex-values)))
(assert-true (string? result)))))
(defsuite
"example:form-reset"
(deftest
"echoes submitted message"
(reset-mocks!)
(set! _mock-form {:message "Hello world"})
(let
((result (run-handler handler:ex-reset-submit)))
(assert-true (contains? result "Hello world"))))
(deftest
"includes timestamp"
(reset-mocks!)
(set! _mock-form {:message "test"})
(let
((result (run-handler handler:ex-reset-submit)))
(assert-true (contains? result _mock-now)))))
(defsuite
"example:row-editing"
(deftest
"form loads row data"
(reset-mocks!)
(set! _mock-args {:row-id "1"})
(let
((result (run-handler handler:ex-editrow-form)))
(assert-true (> (len result) 10))))
(deftest
"save stores row in state"
(reset-mocks!)
(set! _mock-args {:row-id "1"})
(set! _mock-form {:stock "50" :price "9.99" :name "Widget"})
(run-handler handler:ex-editrow-save)
(let
((row (get _mock-state "ex-row-1")))
(assert-equal "Widget" (get row "name"))))
(deftest
"save stores price"
(reset-mocks!)
(set! _mock-args {:row-id "1"})
(set! _mock-form {:stock "5" :price "19.99" :name "X"})
(run-handler handler:ex-editrow-save)
(let
((row (get _mock-state "ex-row-1")))
(assert-equal "19.99" (get row "price"))))
(deftest
"cancel returns view"
(reset-mocks!)
(set! _mock-args {:row-id "1"})
(let
((result (run-handler handler:ex-editrow-cancel)))
(assert-true (> (len result) 10))))
(deftest
"full cycle: edit → save → cancel"
(reset-mocks!)
(set! _mock-args {:row-id "2"})
(let
((form (run-handler handler:ex-editrow-form)))
(do
(assert-true (string? form))
(set! _mock-form {:stock "100" :price "5.00" :name "Gadget"})
(run-handler handler:ex-editrow-save)
(assert-equal "Gadget" (get (get _mock-state "ex-row-2") "name"))
(let
((view (run-handler handler:ex-editrow-cancel)))
(assert-true (string? view)))))))
(defsuite
"example:profile-editing"
(deftest
"edit loads current profile"
(reset-mocks!)
(let
((result (run-handler handler:ex-pp-edit-all)))
(assert-true (string? result))))
(deftest
"put saves all fields"
(reset-mocks!)
(set! _mock-form {:email "bob@test.com" :role "admin" :name "Bob"})
(run-handler handler:ex-pp-put)
(let
((p (get _mock-state "ex-profile")))
(do
(assert-equal "Bob" (get p "name"))
(assert-equal "bob@test.com" (get p "email"))
(assert-equal "admin" (get p "role")))))
(deftest
"cancel returns view"
(reset-mocks!)
(let
((result (run-handler handler:ex-pp-cancel)))
(assert-true (string? result))))
(deftest
"full cycle: edit → put → view"
(reset-mocks!)
(run-handler handler:ex-pp-edit-all)
(set! _mock-form {:email "c@x.com" :role "user" :name "Carol"})
(run-handler handler:ex-pp-put)
(let
((view (run-handler handler:ex-pp-cancel)))
(assert-true (contains? view "Carol")))))
(defsuite
"example:bulk-operations"
(deftest
"activates selected users"
(reset-mocks!)
(set! _mock-args {:action "activate"})
(set! _mock-form {:ids (list "u1" "u2")})
(let
((result (run-handler handler:ex-bulk)))
(assert-true (string? result)))))
(defsuite
"example:swap-modes"
(deftest
"increments counter"
(reset-mocks!)
(set! _mock-args {:mode "beforeend"})
(run-handler handler:ex-swap-log)
(assert-equal 1 (get _mock-state "ex-swap-n")))
(deftest
"returns timestamp"
(reset-mocks!)
(set! _mock-args {:mode "innerHTML"})
(let
((result (run-handler handler:ex-swap-log)))
(assert-true (contains? result _mock-now))))
(deftest
"includes OOB counter update"
(reset-mocks!)
(set! _mock-args {:mode "beforeend"})
(let
((result (run-handler handler:ex-swap-log)))
(assert-true (contains? result "swap-counter")))))
(defsuite
"example:dashboard"
(deftest
"shows user count"
(reset-mocks!)
(let
((result (run-handler handler:ex-dashboard)))
(assert-true (contains? result "142"))))
(deftest
"shows revenue"
(reset-mocks!)
(let
((result (run-handler handler:ex-dashboard)))
(assert-true (contains? result "4.2k"))))
(deftest
"includes timestamp"
(reset-mocks!)
(let
((result (run-handler handler:ex-dashboard)))
(assert-true (contains? result _mock-now)))))
(defsuite
"example:tabs"
(deftest
"returns tab content"
(reset-mocks!)
(set! _mock-args {:tab "features"})
(let
((result (run-handler handler:ex-tabs)))
(assert-true (> (len result) 20))))
(deftest
"includes OOB tab buttons"
(reset-mocks!)
(set! _mock-args {:tab "features"})
(let
((result (run-handler handler:ex-tabs)))
(assert-true (contains? result "tab-buttons")))))
(defsuite
"example:animation"
(deftest
"returns content"
(reset-mocks!)
(let
((result (run-handler handler:ex-animate)))
(assert-true (> (len result) 20))))
(deftest
"includes timestamp"
(reset-mocks!)
(let
((result (run-handler handler:ex-animate)))
(assert-true (contains? result _mock-now)))))
(defsuite
"example:dialog"
(deftest
"open returns modal content"
(reset-mocks!)
(let
((result (run-handler handler:ex-dialog)))
(assert-true (> (len result) 20))))
(deftest
"close returns response"
(reset-mocks!)
(let
((result (run-handler handler:ex-dialog-close)))
(assert-true (string? result)))))
(defsuite
"example:keyboard"
(deftest
"returns action for Enter"
(reset-mocks!)
(set! _mock-args {:key "Enter"})
(let
((result (run-handler handler:ex-keyboard)))
(assert-true (> (len result) 10))))
(deftest
"returns action for Escape"
(reset-mocks!)
(set! _mock-args {:key "Escape"})
(let
((result (run-handler handler:ex-keyboard)))
(assert-true (> (len result) 10)))))
(defsuite
"example:json-echo"
(deftest
"echoes content type"
(reset-mocks!)
(set! _mock-body "{\"key\":\"val\"}")
(set! _mock-content-type "application/json")
(let
((result (run-handler handler:ex-json-echo)))
(assert-true (contains? result "application/json"))))
(deftest
"echoes body"
(reset-mocks!)
(set! _mock-body "{\"hello\":\"world\"}")
(set! _mock-content-type "application/json")
(let
((result (run-handler handler:ex-json-echo)))
(assert-true (contains? result "hello")))))
(defsuite
"example:echo-vals"
(deftest
"echoes query args"
(reset-mocks!)
(set! _mock-args {:foo "bar" :baz "qux"})
(let
((result (run-handler handler:ex-echo-vals)))
(assert-true (string? result)))))
(defsuite
"example:echo-headers"
(deftest
"echoes x-prefixed headers"
(reset-mocks!)
(set! _mock-headers {:x-custom "value" :content-type "text/plain"})
(let
((result (run-handler handler:ex-echo-headers)))
(assert-true (string? result)))))
(defsuite
"example:loading"
(deftest
"returns content (sleep mocked)"
(reset-mocks!)
(let
((result (run-handler handler:ex-slow)))
(assert-true (contains? result _mock-now)))))
(defsuite
"example:dedup-search"
(deftest
"returns search result"
(reset-mocks!)
(set! _mock-args {:q "test"})
(let
((result (run-handler handler:ex-slow-search)))
(assert-true (contains? result "test")))))
(defsuite
"example:retry"
(deftest
"first call increments counter"
(reset-mocks!)
(run-handler handler:ex-flaky)
(assert-equal 1 (get _mock-state "ex-flaky-n")))
(deftest
"third call succeeds (mod 3)"
(reset-mocks!)
(run-handler handler:ex-flaky)
(run-handler handler:ex-flaky)
(let
((result (run-handler handler:ex-flaky)))
(do
(assert-equal 3 (get _mock-state "ex-flaky-n"))
(assert-true (contains? result "Success"))))))

204
web/tests/test-swap-integration.sx Normal file
View File

@@ -0,0 +1,204 @@
(define _mock-form (dict))
(define _mock-args (dict))
(define _mock-state (dict))
(define _mock-body "")
(define _mock-content-type "")
(define _mock-headers (dict))
(define _mock-now "12:00:00")
(define
reset-mocks!
(fn
()
(do
(set! _mock-form (dict))
(set! _mock-args (dict))
(set! _mock-state (dict))
(set! _mock-body "")
(set! _mock-content-type "")
(set! _mock-headers (dict)))))
(define
helper
(fn
(name a1 a2)
(cond
(= name "request-form")
(let
((key (or a1 "")) (default (if (nil? a2) "" a2)))
(let ((val (get _mock-form key))) (if (nil? val) default val)))
(= name "request-arg")
(let
((key (or a1 "")) (default a2))
(let ((val (get _mock-args key))) (if (nil? val) default val)))
(= name "state-get")
(let
((key (or a1 "")) (default a2))
(let ((val (get _mock-state key))) (if (nil? val) default val)))
(= name "state-set!")
(do (set! _mock-state (assoc _mock-state a1 a2)) nil)
(= name "now")
_mock-now
(= name "component-source")
(str "(defcomp " a1 " () (div))")
(= name "request-json")
_mock-body
(= name "request-content-type")
_mock-content-type
(= name "request-form-list")
(or (get _mock-form a1) (list))
(= name "request-args-all")
_mock-args
(= name "request-headers-all")
_mock-headers
(= name "request-form-all")
_mock-form
(= name "request-header")
(or (get _mock-headers a1) a2)
(= name "request-file-name")
(or (get _mock-form a1) "")
(= name "into")
(let
((coll (if (nil? a2) a1 a2)))
(if
(dict? coll)
(map (fn (key) (list key (get coll key))) (keys coll))
(if (nil? coll) (list) coll)))
:else nil)))
(define sleep (fn (ms) nil))
(define set-response-status (fn (code) nil))
(define json-encode (fn (val) (inspect val)))
(define
run-handler
(fn
(hdef)
(let
((result (aser (get hdef "body") (get hdef "closure"))))
(if
(sx-expr? result)
(sx-expr-source result)
(if (string? result) result (str result))))))
(defsuite
"swap:click-to-load"
(deftest
"innerHTML replaces target content"
(reset-mocks!)
(let
((page "(div :id \"click-result\" (p \"Click the button\"))")
(response (run-handler handler:ex-click)))
(let
((result (sx-swap page "innerHTML" "click-result" response)))
(do
(assert-true (contains? result "~examples/click-result"))
(assert-true (contains? result "12:00:00"))
(assert-false (contains? result "Click the button")))))))
(defsuite
"swap:form-submission"
(deftest
"innerHTML replaces with greeting"
(reset-mocks!)
(set! _mock-form {:name "Alice"})
(let
((page "(div :id \"form-result\" (p \"Submit the form\"))")
(response (run-handler handler:ex-form)))
(let
((result (sx-swap page "innerHTML" "form-result" response)))
(do
(assert-true (contains? result "Alice"))
(assert-false (contains? result "Submit the form")))))))
(defsuite
"swap:polling"
(deftest
"innerHTML shows counter after increment"
(reset-mocks!)
(let
((page "(div :id \"poll-result\" (p \"Waiting...\"))")
(response (run-handler handler:ex-poll)))
(let
((result (sx-swap page "innerHTML" "poll-result" response)))
(do
(assert-true (contains? result "1"))
(assert-false (contains? result "Waiting")))))))
(defsuite
"swap:oob-updates"
(deftest
"primary + OOB both update"
(reset-mocks!)
(let
((page "(div (div :id \"oob-box-a\" (p \"A old\")) (div :id \"oob-box-b\" (p \"B old\")))")
(response (run-handler handler:ex-oob)))
(let
((result (apply-response page response "innerHTML" "oob-box-a")))
(do
(assert-true (contains? result "Box A updated!"))
(assert-true (contains? result "Box B updated!"))
(assert-false (contains? result "A old"))
(assert-false (contains? result "B old")))))))
(defsuite
"swap:search"
(deftest
"innerHTML replaces search results"
(reset-mocks!)
(set! _mock-args {:q "Python"})
(let
((page "(div :id \"search-result\" (p \"Type to search\"))")
(response (run-handler handler:ex-search)))
(let
((result (sx-swap page "innerHTML" "search-result" response)))
(do
(assert-true (contains? result "Python"))
(assert-false (contains? result "Type to search")))))))
(defsuite
"swap:delete-row"
(deftest
"outerHTML removes element"
(let
((page "(table (tr :id \"row-1\" (td \"Item 1\")) (tr :id \"row-2\" (td \"Item 2\")))")
(response ""))
(let
((result (sx-swap page "outerHTML" "row-1" response)))
(do
(assert-false (contains? result "Item 1"))
(assert-true (contains? result "Item 2")))))))
(defsuite
"swap:beforeend"
(deftest
"appends new item to list"
(let
((page "(ul :id \"items\" (li \"first\"))") (response "(li \"second\")"))
(let
((result (sx-swap page "beforeend" "items" response)))
(do
(assert-true (contains? result "first"))
(assert-true (contains? result "second")))))))
(defsuite
"swap:state-across-calls"
(deftest
"counter increments across handler calls"
(reset-mocks!)
(let
((r1 (run-handler handler:ex-poll)))
(let
((r2 (run-handler handler:ex-poll)))
(let
((page "(div :id \"counter\" (span \"0\"))")
(result (sx-swap page "innerHTML" "counter" r2)))
(assert-true (contains? result "2")))))))