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

HS: Group 11 misc — toggle-var-cycle, closest-to, tailwind class, toggle timing (+3 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 6m13s
Details

Browse Source 
- parser: `toggle $var between v1 and v2 ...` → `(toggle-var-cycle $var (v1 v2 ...))`
- compiler: emit `(hs-toggle-var-cycle! win var-name values)` for new AST node
- runtime: `hs-toggle-var-cycle!` cycles through a list of values on a variable
- parser: `closest .sel to .target` / `closest #id to .target` / `closest sel to .target`
  now consumes the `to` keyword and parses the target expr instead of defaulting to beingTold
- tokenizer: `read-class-name` handles backslash escapes and allows `(`, `)`, `&`
  chars so Tailwind classes like `group-[:nth-of-type(3)_&]:block` tokenize correctly
- platform.py: `domListen` drives async result via `_driveAsync` after `cekCall`
- test: fixed-time toggle asserts `.foo` IS present after click (toggle started, 10ms window open)
- generate-sx-tests.py: aligned MANUAL_TEST_BODIES for timed toggle with corrected assertion

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-05-04 17:03:52 +00:00
parent d47db58cde
commit d9b7e1e392
12 changed files with 569 additions and 306 deletions
Download Patch File Download Diff File Expand all files Collapse all files

128
shared/static/wasm/sx/hs-runtime.sx
View File

@@ -162,6 +162,28 @@
(host-call (host-get target "classList") "toggle" cls)))
;; First element matching selector within a scope.
(define
hs-toggle-var-cycle!
(fn
(win var-name values)
(let
((current (host-get win var-name)) (n (len values)))
(define
find-idx
(fn
(i)
(if
(>= i n)
-1
(if (= (nth values i) current) i (find-idx (+ i 1))))))
(let
((idx (find-idx 0)))
(host-set!
win
var-name
(if (= idx -1) (first values) (nth values (mod (+ idx 1) n))))))))
;; Last element matching selector.
(define
hs-toggle-between!
(fn
@@ -172,7 +194,7 @@
(do (dom-remove-class target cls1) (dom-add-class target cls2))
(do (dom-remove-class target cls2) (dom-add-class target cls1)))))
;; Last element matching selector.
;; First/last within a specific scope.
(define
hs-toggle-style!
(fn
@@ -196,7 +218,6 @@
(dom-set-style target prop "hidden")
(dom-set-style target prop "")))))))
;; First/last within a specific scope.
(define
hs-toggle-style-between!
(fn
@@ -208,6 +229,9 @@
(dom-set-style target prop val2)
(dom-set-style target prop val1)))))
;; ── Iteration ───────────────────────────────────────────────────
;; Repeat a thunk N times.
(define
hs-toggle-style-cycle!
(fn
@@ -228,9 +252,7 @@
(true (find-next (rest remaining))))))
(dom-set-style target prop (find-next vals)))))
;; ── Iteration ───────────────────────────────────────────────────
;; Repeat a thunk N times.
;; Repeat forever (until break — relies on exception/continuation).
(define
hs-take!
(fn
@@ -270,7 +292,10 @@
(dom-set-attr target name attr-val)
(dom-set-attr target name ""))))))))
;; Repeat forever (until break — relies on exception/continuation).
;; ── Fetch ───────────────────────────────────────────────────────
;; Fetch a URL, parse response according to format.
;; (hs-fetch url format) — format is "json" | "text" | "html"
(begin
(define
hs-element?
@@ -417,10 +442,10 @@
(dom-insert-adjacent-html target "beforeend" value)
(hs-boot-subtree! target))))))))))
;; ── Fetch ───────────────────────────────────────────────────────
;; ── Type coercion ───────────────────────────────────────────────
;; Fetch a URL, parse response according to format.
;; (hs-fetch url format) — format is "json" | "text" | "html"
;; Coerce a value to a type by name.
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
(define
hs-add-to!
(fn
@@ -433,10 +458,10 @@
(append target (list value))))
(true (do (host-call target "push" value) target)))))
;; ── Type coercion ───────────────────────────────────────────────
;; ── Object creation ─────────────────────────────────────────────
;; Coerce a value to a type by name.
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
;; Make a new object of a given type.
;; (hs-make type-name) — creates empty object/collection
(define
hs-remove-from!
(fn
@@ -446,10 +471,11 @@
(filter (fn (x) (not (= x value))) target)
(host-call target "splice" (host-call target "indexOf" value) 1))))
;; ── Object creation ─────────────────────────────────────────────
;; ── Behavior installation ───────────────────────────────────────
;; Make a new object of a given type.
;; (hs-make type-name) — creates empty object/collection
;; Install a behavior on an element.
;; A behavior is a function that takes (me ...params) and sets up features.
;; (hs-install behavior-fn me ...args)
(define
hs-splice-at!
(fn
@@ -473,11 +499,10 @@
(host-call target "splice" i 1))))
target))))
;; ── Behavior installation ───────────────────────────────────────
;; ── Measurement ─────────────────────────────────────────────────
;; Install a behavior on an element.
;; A behavior is a function that takes (me ...params) and sets up features.
;; (hs-install behavior-fn me ...args)
;; Measure an element's bounding rect, store as local variables.
;; Returns a dict with x, y, width, height, top, left, right, bottom.
(define
hs-index
(fn
@@ -489,10 +514,10 @@
((string? obj) (nth obj key))
(true (host-get obj key)))))
;; ── Measurement ─────────────────────────────────────────────────
;; Measure an element's bounding rect, store as local variables.
;; Returns a dict with x, y, width, height, top, left, right, bottom.
;; Return the current text selection as a string. In the browser this is
;; `window.getSelection().toString()`. In the mock test runner, a test
;; setup stashes the desired selection text at `window.__test_selection`
;; and the fallback path returns that so tests can assert on the result.
(define
hs-put-at!
(fn
@@ -514,10 +539,11 @@
((= pos "start") (host-call target "unshift" value)))
target)))))))
;; Return the current text selection as a string. In the browser this is
;; `window.getSelection().toString()`. In the mock test runner, a test
;; setup stashes the desired selection text at `window.__test_selection`
;; and the fallback path returns that so tests can assert on the result.
;; ── Transition ──────────────────────────────────────────────────
;; Transition a CSS property to a value, optionally with duration.
;; (hs-transition target prop value duration)
(define
hs-dict-without
(fn
@@ -538,11 +564,6 @@
(host-call (host-global "Reflect") "deleteProperty" out key)
out)))))
;; ── Transition ──────────────────────────────────────────────────
;; Transition a CSS property to a value, optionally with duration.
;; (hs-transition target prop value duration)
(define
hs-set-on!
(fn
@@ -605,7 +626,10 @@
(do
(host-call ev "preventDefault")
(host-call ev "stopPropagation")))))
(when (not (= mode "the-event")) (raise (list (if (= mode "default") "hs-halt-default" "hs-return") nil))))))
(when
(not (= mode "the-event"))
(raise
(list (if (= mode "default") "hs-halt-default" "hs-return") nil))))))
(define hs-select! (fn (target) (host-call target "select" (list))))
@@ -670,6 +694,10 @@
(when default-val (dom-set-prop target "value" default-val)))))
(true nil)))))))
(define
hs-next
(fn
@@ -689,10 +717,6 @@
(true (find-next (dom-next-sibling el))))))
(find-next sibling)))))
(define
hs-previous
(fn
@@ -711,10 +735,10 @@
((dom-matches? el sel) el)
(true (find-prev (dom-get-prop el "previousElementSibling"))))))
(find-prev sibling)))))
(define _hs-last-query-sel nil)
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
(define _hs-last-query-sel nil)
;; DOM query stub — sandbox returns empty list
(define
hs-null-raise!
(fn
@@ -725,7 +749,7 @@
((msg (str "'" (or (host-get (host-global "window") "_hs_last_query_sel") "target") "' is null")))
(host-set! (host-global "window") "_hs_null_error" msg)
(guard (_null-e (true nil)) (raise msg))))))
;; DOM query stub — sandbox returns empty list
;; Method dispatch — obj.method(args)
(define
hs-empty-raise!
(fn
@@ -739,7 +763,9 @@
((msg (str "'" (or (host-get (host-global "window") "_hs_last_query_sel") "target") "' is null")))
(host-set! (host-global "window") "_hs_null_error" msg)
(guard (_null-e (true nil)) (raise msg))))))
;; Method dispatch — obj.method(args)
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
(define
hs-query-all-checked
(fn
@@ -747,16 +773,14 @@
(let
((result (hs-query-all sel)))
(do (hs-empty-raise! result) result))))
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
;; Property-based is — check obj.key truthiness
(define
hs-dispatch!
(fn
(target event detail)
(hs-null-raise! target)
(dom-dispatch target event detail)))
;; Property-based is — check obj.key truthiness
;; Array slicing (inclusive both ends)
(define
hs-query-all
(fn
@@ -764,7 +788,7 @@
(do
(host-set! (host-global "window") "_hs_last_query_sel" sel)
(dom-query-all (dom-document) sel))))
;; Array slicing (inclusive both ends)
;; Collection: sorted by
(define
hs-query-all-in
(fn
@@ -773,17 +797,17 @@
(nil? target)
(hs-query-all sel)
(host-call target "querySelectorAll" sel))))
;; Collection: sorted by
;; Collection: sorted by descending
(define
hs-list-set
(fn
(lst idx val)
(append (take lst idx) (cons val (drop lst (+ idx 1))))))
;; Collection: sorted by descending
;; Collection: split by
(define
hs-to-number
(fn (v) (if (number? v) v (or (parse-number (str v)) 0))))
;; Collection: split by
;; Collection: joined by
(define
hs-query-first
(fn
@@ -791,7 +815,7 @@
(do
(host-set! (host-global "window") "_hs_last_query_sel" sel)
(host-call (host-global "document") "querySelector" sel))))
;; Collection: joined by
(define
hs-query-last
(fn
@@ -2662,6 +2686,8 @@
((= (dom-get-attr el "dom-scope") "isolated") nil)
(true (hs-dom-walk (dom-parent el) name)))))
;; ── SourceInfo API ────────────────────────────────────────────────
(define
hs-dom-find-owner
(fn
@@ -2672,8 +2698,6 @@
((= (dom-get-attr el "dom-scope") "isolated") nil)
(true (hs-dom-find-owner (dom-parent el) name)))))
;; ── SourceInfo API ────────────────────────────────────────────────
(define
hs-dom-get
(fn (el name) (hs-dom-walk (hs-dom-resolve-start el) name)))