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

9
shared/static/wasm/sx/hs-compiler.sx
View File

@@ -469,7 +469,8 @@
(= name "meta")
(= name "event")
(= name "it")
(= name "result")))
(= name "result"))))
(define
emit-for
(fn
(ast)
@@ -1806,6 +1807,12 @@
(if source (hs-to-sx source) (quote me))
event-name)
(list (quote hs-toggle-class!) tgt cls))))
((= head (quote toggle-var-cycle))
(list
(quote hs-toggle-var-cycle!)
(list (quote host-global) "window")
(nth ast 1)
(cons (quote list) (map hs-to-sx (nth ast 2)))))
((= head (quote set-on))
(list
(quote hs-set-on!)

63
shared/static/wasm/sx/hs-parser.sx
View File

@@ -140,15 +140,35 @@
((and (= kind (quote closest)) (= typ "ident") (= val "parent"))
(do (adv!) (parse-trav (quote closest-parent))))
((= typ "selector")
(do (adv!) (list kind val (list (quote beingTold)))))
(do
(adv!)
(list
kind
val
(if
(and (= kind (quote closest)) (match-kw "to"))
(parse-expr)
(list (quote beingTold))))))
((= typ "class")
(do
(adv!)
(list kind (str "." val) (list (quote beingTold)))))
(list
kind
(str "." val)
(if
(and (= kind (quote closest)) (match-kw "to"))
(parse-expr)
(list (quote beingTold))))))
((= typ "id")
(do
(adv!)
(list kind (str "#" val) (list (quote beingTold)))))
(list
kind
(str "#" val)
(if
(and (= kind (quote closest)) (match-kw "to"))
(parse-expr)
(list (quote beingTold))))))
((= typ "attr")
(do
(adv!)
@@ -1493,6 +1513,40 @@
((tgt (nth expr 1)) (cls (nth expr 2)))
(list (quote toggle-class) cls tgt)))
(true nil)))))
((and (= (tp-type) "ident") (> (len (tp-val)) 0) (= (substring (tp-val) 0 1) "$"))
(let
((var-name (tp-val)))
(adv!)
(if
(match-kw "between")
(let
((val1 (parse-atom)))
(define
collect-vals
(fn
(acc)
(if
(or
(= (tp-type) "comma")
(and
(= (tp-type) "keyword")
(= (tp-val) "and")))
(do
(when (= (tp-type) "comma") (adv!))
(when
(and
(= (tp-type) "keyword")
(= (tp-val) "and"))
(adv!))
(collect-vals (append acc (list (parse-atom)))))
acc)))
(let
((more-vals (collect-vals (list))))
(list
(quote toggle-var-cycle)
var-name
(cons val1 more-vals))))
nil)))
(true nil))))
(define
parse-set-cmd
@@ -2451,7 +2505,8 @@
(if
(or
(at-end?)
(and (= (tp-type) "keyword") (= (tp-val) "end")))
(and (= (tp-type) "keyword") (= (tp-val) "end"))
(and (= (tp-type) "keyword") (= (tp-val) "behavior")))
acc
(let
((feat (parse-feat)))

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)))

89
shared/static/wasm/sx/hs-tokenizer.sx
View File

@@ -335,11 +335,17 @@
(= ch "r")
(do (append! chars "\r") (hs-advance! 1))
(= ch "b")
(do (append! chars (char-from-code 8)) (hs-advance! 1))
(do
(append! chars (char-from-code 8))
(hs-advance! 1))
(= ch "f")
(do (append! chars (char-from-code 12)) (hs-advance! 1))
(do
(append! chars (char-from-code 12))
(hs-advance! 1))
(= ch "v")
(do (append! chars (char-from-code 11)) (hs-advance! 1))
(do
(append! chars (char-from-code 11))
(hs-advance! 1))
(= ch "\\")
(do (append! chars "\\") (hs-advance! 1))
(= ch quote-char)
@@ -354,12 +360,16 @@
(hs-hex-digit? (hs-peek 1)))
(let
((d1 (hs-hex-val (hs-cur)))
(d2 (hs-hex-val (hs-peek 1))))
(append! chars (char-from-code (+ (* d1 16) d2)))
(d2 (hs-hex-val (hs-peek 1))))
(append!
chars
(char-from-code (+ (* d1 16) d2)))
(hs-advance! 2))
(error "Invalid hexadecimal escape: \\x")))
:else
(do (append! chars "\\") (append! chars ch) (hs-advance! 1)))))
:else (do
(append! chars "\\")
(append! chars ch)
(hs-advance! 1)))))
(loop))
(= (hs-cur) quote-char)
(hs-advance! 1)
@@ -446,24 +456,34 @@
read-class-name
(fn
(start)
(when
(and
(< pos src-len)
(or
(hs-ident-char? (hs-cur))
(= (hs-cur) ":")
(= (hs-cur) "[")
(= (hs-cur) "]")))
(hs-advance! 1)
(read-class-name start))
(slice src start pos)))
(define
build-name
(fn
(acc)
(cond
((and (< pos src-len) (= (hs-cur) "\\") (< (+ pos 1) src-len))
(do
(hs-advance! 1)
(let
((c (hs-cur)))
(hs-advance! 1)
(build-name (str acc c)))))
((and (< pos src-len) (or (hs-ident-char? (hs-cur)) (= (hs-cur) ":") (= (hs-cur) "[") (= (hs-cur) "]") (= (hs-cur) "(") (= (hs-cur) ")") (= (hs-cur) "&")))
(do
(let
((c (hs-cur)))
(hs-advance! 1)
(build-name (str acc c)))))
(true acc))))
(build-name "")))
(define
hs-emit!
(fn
(type value start)
(let
((tok (hs-make-token type value start))
(end-pos (max pos (+ start (if (nil? value) 0 (len (str value)))))))
(end-pos
(max pos (+ start (if (nil? value) 0 (len (str value)))))))
(do
(dict-set! tok "end" end-pos)
(dict-set! tok "line" (len (split (slice src 0 start) "\n")))
@@ -504,11 +524,17 @@
(and
(= ch ".")
(< (+ pos 1) src-len)
(or (hs-letter? (hs-peek 1)) (= (hs-peek 1) "-") (= (hs-peek 1) "_"))
(or
(hs-letter? (hs-peek 1))
(= (hs-peek 1) "-")
(= (hs-peek 1) "_"))
(> (len tokens) 0)
(let
((lt (dict-get (nth tokens (- (len tokens) 1)) :type)))
(or (= lt "paren-close") (= lt "brace-close") (= lt "bracket-close"))))
(or
(= lt "paren-close")
(= lt "brace-close")
(= lt "bracket-close"))))
(do (hs-emit! "dot" "." start) (hs-advance! 1) (scan!))
(and
(= ch ".")
@@ -528,7 +554,10 @@
(> (len tokens) 0)
(let
((lt (dict-get (nth tokens (- (len tokens) 1)) :type)))
(or (= lt "paren-close") (= lt "brace-close") (= lt "bracket-close"))))
(or
(= lt "paren-close")
(= lt "brace-close")
(= lt "bracket-close"))))
(do (hs-emit! "op" "#" start) (hs-advance! 1) (scan!))
(and
(= ch "#")
@@ -599,21 +628,7 @@
(let
((word (read-ident start)))
(let
((full-word
(if
(and
(< pos src-len)
(= (hs-cur) "'")
(< (+ pos 1) src-len)
(hs-letter? (hs-peek 1))
(not
(and
(= (hs-peek 1) "s")
(or
(>= (+ pos 2) src-len)
(not (hs-ident-char? (hs-peek 2)))))))
(do (hs-advance! 1) (str word "'" (read-ident pos)))
word)))
((full-word (if (and (< pos src-len) (= (hs-cur) "'") (< (+ pos 1) src-len) (hs-letter? (hs-peek 1)) (not (and (= (hs-peek 1) "s") (or (>= (+ pos 2) src-len) (not (hs-ident-char? (hs-peek 2))))))) (do (hs-advance! 1) (str word "'" (read-ident pos))) word)))
(hs-emit!
(if (hs-keyword? full-word) "keyword" "ident")
full-word