HS: wait on event basics (+4 tests)

Five parts: (a) tests/hs-run-filtered.js `io-wait-event` mock now
registers a one-shot listener on the target element and resumes with
the event, instead of immediately resuming with nil. (b) Added
hs-wait-for-or runtime form carrying a timeout-ms; mock resumes
immediately when a timeout is present (0ms tests). (c) parser
parse-wait-cmd recognises `wait for EV(v1, v2)` destructure syntax,
emits :destructure list on wait-for AST. (d) compiler emit-wait-for
updated for :from/:or combos; a new `__bind-from-detail__` form
compiles to `(define v (host-get (host-get it "detail") v))`, and the
`do`-sequence handler preprocesses wait-for to splice these synthetic
bindings after the wait. (e) generator extracts `detail: ...` from
`CustomEvent` options so dispatched events carry their payload.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-04-24 06:05:53 +00:00
parent e8a89a6ce2
commit f79f96c1c3
9 changed files with 248 additions and 133 deletions

View File

@@ -348,11 +348,30 @@
(fn (fn
(ast) (ast)
(let (let
((event-name (nth ast 1))) ((event-name (nth ast 1))
(if (has-from (and (> (len ast) 2) (= (nth ast 2) :from)))
(and (> (len ast) 2) (= (nth ast 2) :from)) (has-from-or
(list (quote hs-wait-for) (hs-to-sx (nth ast 3)) event-name) (and
(list (quote hs-wait-for) (quote me) event-name))))) (> (len ast) 4)
(= (nth ast 2) :from)
(= (nth ast 4) :or)))
(has-or (and (> (len ast) 2) (= (nth ast 2) :or))))
(cond
(has-from-or
(list
(quote hs-wait-for-or)
(hs-to-sx (nth ast 3))
event-name
(nth ast 5)))
(has-from
(list (quote hs-wait-for) (hs-to-sx (nth ast 3)) event-name))
(has-or
(list
(quote hs-wait-for-or)
(quote me)
event-name
(nth ast 3)))
(true (list (quote hs-wait-for) (quote me) event-name))))))
(define (define
emit-transition emit-transition
(fn (fn
@@ -666,6 +685,16 @@
(let (let
((head (first ast))) ((head (first ast)))
(cond (cond
((= head (quote __bind-from-detail__))
(let
((name-str (nth ast 1)))
(list
(quote define)
(make-symbol name-str)
(list
(quote host-get)
(list (quote host-get) (quote it) "detail")
name-str))))
((= head (quote sender)) ((= head (quote sender))
(list (quote hs-sender) (quote event))) (list (quote hs-sender) (quote event)))
((= head (quote null-literal)) nil) ((= head (quote null-literal)) nil)
@@ -1500,47 +1529,50 @@
(hs-to-sx (nth ast 2))))) (hs-to-sx (nth ast 2)))))
((= head (quote do)) ((= head (quote do))
(let (let
((compiled (map hs-to-sx (rest ast)))) ((expanded (reduce (fn (acc c) (if (and (list? c) (> (len c) 0) (= (first c) (quote wait-for)) (contains? c :destructure)) (let ((dest-names (let ((lst c)) (define scan-dest (fn (i) (cond ((>= i (- (len lst) 1)) (list)) ((= (nth lst i) :destructure) (nth lst (+ i 1))) (true (scan-dest (+ i 2)))))) (scan-dest 2))) (stripped (let ((lst c)) (define strip-dest (fn (i) (cond ((>= i (len lst)) (list)) ((and (< i (- (len lst) 1)) (= (nth lst i) :destructure)) (strip-dest (+ i 2))) (true (cons (nth lst i) (strip-dest (+ i 1))))))) (strip-dest 0)))) (append (append acc (list stripped)) (map (fn (n) (list (quote __bind-from-detail__) n)) dest-names))) (append acc (list c)))) (list) (rest ast))))
(if (let
(and ((compiled (map hs-to-sx expanded)))
(> (len compiled) 1) (if
(some (and
(> (len compiled) 1)
(some
(fn
(c)
(and
(list? c)
(or
(= (first c) (quote hs-fetch))
(= (first c) (quote hs-wait))
(= (first c) (quote hs-wait-for))
(= (first c) (quote hs-wait-for-or))
(= (first c) (quote hs-query-first))
(= (first c) (quote hs-query-all))
(= (first c) (quote perform)))))
compiled))
(reduce
(fn (fn
(c) (body cmd)
(and (if
(list? c) (and
(or (list? cmd)
(= (first c) (quote hs-fetch)) (= (first cmd) (quote hs-fetch)))
(= (first c) (quote hs-wait))
(= (first c) (quote hs-wait-for))
(= (first c) (quote hs-query-first))
(= (first c) (quote hs-query-all))
(= (first c) (quote perform)))))
compiled))
(reduce
(fn
(body cmd)
(if
(and
(list? cmd)
(= (first cmd) (quote hs-fetch)))
(list
(quote let)
(list (list (quote it) cmd))
(list (list
(quote begin) (quote let)
(list (list (quote it) cmd))
(list (list
(quote set!) (quote begin)
(quote the-result) (list
(quote it)) (quote set!)
body)) (quote the-result)
(list (quote it))
(quote let) body))
(list (list (quote it) cmd)) (list
body))) (quote let)
(nth compiled (- (len compiled) 1)) (list (list (quote it) cmd))
(rest (reverse compiled))) body)))
(cons (quote do) compiled)))) (nth compiled (- (len compiled) 1))
(rest (reverse compiled)))
(cons (quote do) compiled)))))
((= head (quote wait)) (list (quote hs-wait) (nth ast 1))) ((= head (quote wait)) (list (quote hs-wait) (nth ast 1)))
((= head (quote wait-for)) (emit-wait-for ast)) ((= head (quote wait-for)) (emit-wait-for ast))
((= head (quote log)) ((= head (quote log))

View File

@@ -1386,21 +1386,17 @@
((event-name (tp-val))) ((event-name (tp-val)))
(adv!) (adv!)
(let (let
((source (if (match-kw "from") (parse-expr) nil))) ((destructure (if (= (tp-type) "paren-open") (let ((_ (adv!))) (define collect-dnames (fn (acc) (cond ((or (= (tp-type) "paren-close") (at-end?)) (do (if (= (tp-type) "paren-close") (adv!) nil) acc)) ((= (tp-type) "comma") (do (adv!) (collect-dnames acc))) (true (let ((name (tp-val))) (adv!) (collect-dnames (append acc (list name)))))))) (collect-dnames (list))) nil)))
(let (let
((timeout-dur (if (match-kw "or") (if (= (tp-type) "number") (let ((tok (adv!))) (let ((raw (get tok "value")) (suffix (if (and (= (tp-type) "ident") (or (= (tp-val) "ms") (= (tp-val) "s"))) (get (adv!) "value") ""))) (parse-dur (str raw suffix)))) nil) nil))) ((source (if (match-kw "from") (parse-expr) nil)))
(cond (let
((and source timeout-dur) ((timeout-dur (if (match-kw "or") (if (= (tp-type) "number") (let ((tok (adv!))) (let ((raw (get tok "value")) (suffix (if (and (= (tp-type) "ident") (or (= (tp-val) "ms") (= (tp-val) "s"))) (get (adv!) "value") ""))) (parse-dur (str raw suffix)))) nil) nil)))
(list (let
(quote wait-for) ((base (cond ((and source timeout-dur) (list (quote wait-for) event-name :from source :or timeout-dur)) (source (list (quote wait-for) event-name :from source)) (timeout-dur (list (quote wait-for) event-name :or timeout-dur)) (true (list (quote wait-for) event-name)))))
event-name (if
:from source destructure
:or timeout-dur)) (append base (list :destructure destructure))
(source base)))))))
(list (quote wait-for) event-name :from source))
(timeout-dur
(list (quote wait-for) event-name :or timeout-dur))
(true (list (quote wait-for) event-name)))))))
((= (tp-type) "number") ((= (tp-type) "number")
(let (let
((tok (adv!))) ((tok (adv!)))

View File

@@ -48,11 +48,17 @@
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms)))) (define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
;; Wait for CSS transitions/animations to settle on an element. ;; Wait for CSS transitions/animations to settle on an element.
(define (begin
hs-wait-for (define
(fn hs-wait-for
(target event-name) (fn
(perform (list (quote io-wait-event) target event-name)))) (target event-name)
(perform (list (quote io-wait-event) target event-name))))
(define
hs-wait-for-or
(fn
(target event-name timeout-ms)
(perform (list (quote io-wait-event) target event-name timeout-ms)))))
;; ── Class manipulation ────────────────────────────────────────── ;; ── Class manipulation ──────────────────────────────────────────

View File

@@ -348,11 +348,30 @@
(fn (fn
(ast) (ast)
(let (let
((event-name (nth ast 1))) ((event-name (nth ast 1))
(if (has-from (and (> (len ast) 2) (= (nth ast 2) :from)))
(and (> (len ast) 2) (= (nth ast 2) :from)) (has-from-or
(list (quote hs-wait-for) (hs-to-sx (nth ast 3)) event-name) (and
(list (quote hs-wait-for) (quote me) event-name))))) (> (len ast) 4)
(= (nth ast 2) :from)
(= (nth ast 4) :or)))
(has-or (and (> (len ast) 2) (= (nth ast 2) :or))))
(cond
(has-from-or
(list
(quote hs-wait-for-or)
(hs-to-sx (nth ast 3))
event-name
(nth ast 5)))
(has-from
(list (quote hs-wait-for) (hs-to-sx (nth ast 3)) event-name))
(has-or
(list
(quote hs-wait-for-or)
(quote me)
event-name
(nth ast 3)))
(true (list (quote hs-wait-for) (quote me) event-name))))))
(define (define
emit-transition emit-transition
(fn (fn
@@ -666,6 +685,16 @@
(let (let
((head (first ast))) ((head (first ast)))
(cond (cond
((= head (quote __bind-from-detail__))
(let
((name-str (nth ast 1)))
(list
(quote define)
(make-symbol name-str)
(list
(quote host-get)
(list (quote host-get) (quote it) "detail")
name-str))))
((= head (quote sender)) ((= head (quote sender))
(list (quote hs-sender) (quote event))) (list (quote hs-sender) (quote event)))
((= head (quote null-literal)) nil) ((= head (quote null-literal)) nil)
@@ -1500,47 +1529,50 @@
(hs-to-sx (nth ast 2))))) (hs-to-sx (nth ast 2)))))
((= head (quote do)) ((= head (quote do))
(let (let
((compiled (map hs-to-sx (rest ast)))) ((expanded (reduce (fn (acc c) (if (and (list? c) (> (len c) 0) (= (first c) (quote wait-for)) (contains? c :destructure)) (let ((dest-names (let ((lst c)) (define scan-dest (fn (i) (cond ((>= i (- (len lst) 1)) (list)) ((= (nth lst i) :destructure) (nth lst (+ i 1))) (true (scan-dest (+ i 2)))))) (scan-dest 2))) (stripped (let ((lst c)) (define strip-dest (fn (i) (cond ((>= i (len lst)) (list)) ((and (< i (- (len lst) 1)) (= (nth lst i) :destructure)) (strip-dest (+ i 2))) (true (cons (nth lst i) (strip-dest (+ i 1))))))) (strip-dest 0)))) (append (append acc (list stripped)) (map (fn (n) (list (quote __bind-from-detail__) n)) dest-names))) (append acc (list c)))) (list) (rest ast))))
(if (let
(and ((compiled (map hs-to-sx expanded)))
(> (len compiled) 1) (if
(some (and
(> (len compiled) 1)
(some
(fn
(c)
(and
(list? c)
(or
(= (first c) (quote hs-fetch))
(= (first c) (quote hs-wait))
(= (first c) (quote hs-wait-for))
(= (first c) (quote hs-wait-for-or))
(= (first c) (quote hs-query-first))
(= (first c) (quote hs-query-all))
(= (first c) (quote perform)))))
compiled))
(reduce
(fn (fn
(c) (body cmd)
(and (if
(list? c) (and
(or (list? cmd)
(= (first c) (quote hs-fetch)) (= (first cmd) (quote hs-fetch)))
(= (first c) (quote hs-wait))
(= (first c) (quote hs-wait-for))
(= (first c) (quote hs-query-first))
(= (first c) (quote hs-query-all))
(= (first c) (quote perform)))))
compiled))
(reduce
(fn
(body cmd)
(if
(and
(list? cmd)
(= (first cmd) (quote hs-fetch)))
(list
(quote let)
(list (list (quote it) cmd))
(list (list
(quote begin) (quote let)
(list (list (quote it) cmd))
(list (list
(quote set!) (quote begin)
(quote the-result) (list
(quote it)) (quote set!)
body)) (quote the-result)
(list (quote it))
(quote let) body))
(list (list (quote it) cmd)) (list
body))) (quote let)
(nth compiled (- (len compiled) 1)) (list (list (quote it) cmd))
(rest (reverse compiled))) body)))
(cons (quote do) compiled)))) (nth compiled (- (len compiled) 1))
(rest (reverse compiled)))
(cons (quote do) compiled)))))
((= head (quote wait)) (list (quote hs-wait) (nth ast 1))) ((= head (quote wait)) (list (quote hs-wait) (nth ast 1)))
((= head (quote wait-for)) (emit-wait-for ast)) ((= head (quote wait-for)) (emit-wait-for ast))
((= head (quote log)) ((= head (quote log))

View File

@@ -1386,21 +1386,17 @@
((event-name (tp-val))) ((event-name (tp-val)))
(adv!) (adv!)
(let (let
((source (if (match-kw "from") (parse-expr) nil))) ((destructure (if (= (tp-type) "paren-open") (let ((_ (adv!))) (define collect-dnames (fn (acc) (cond ((or (= (tp-type) "paren-close") (at-end?)) (do (if (= (tp-type) "paren-close") (adv!) nil) acc)) ((= (tp-type) "comma") (do (adv!) (collect-dnames acc))) (true (let ((name (tp-val))) (adv!) (collect-dnames (append acc (list name)))))))) (collect-dnames (list))) nil)))
(let (let
((timeout-dur (if (match-kw "or") (if (= (tp-type) "number") (let ((tok (adv!))) (let ((raw (get tok "value")) (suffix (if (and (= (tp-type) "ident") (or (= (tp-val) "ms") (= (tp-val) "s"))) (get (adv!) "value") ""))) (parse-dur (str raw suffix)))) nil) nil))) ((source (if (match-kw "from") (parse-expr) nil)))
(cond (let
((and source timeout-dur) ((timeout-dur (if (match-kw "or") (if (= (tp-type) "number") (let ((tok (adv!))) (let ((raw (get tok "value")) (suffix (if (and (= (tp-type) "ident") (or (= (tp-val) "ms") (= (tp-val) "s"))) (get (adv!) "value") ""))) (parse-dur (str raw suffix)))) nil) nil)))
(list (let
(quote wait-for) ((base (cond ((and source timeout-dur) (list (quote wait-for) event-name :from source :or timeout-dur)) (source (list (quote wait-for) event-name :from source)) (timeout-dur (list (quote wait-for) event-name :or timeout-dur)) (true (list (quote wait-for) event-name)))))
event-name (if
:from source destructure
:or timeout-dur)) (append base (list :destructure destructure))
(source base)))))))
(list (quote wait-for) event-name :from source))
(timeout-dur
(list (quote wait-for) event-name :or timeout-dur))
(true (list (quote wait-for) event-name)))))))
((= (tp-type) "number") ((= (tp-type) "number")
(let (let
((tok (adv!))) ((tok (adv!)))
@@ -2476,6 +2472,14 @@
(let (let
((acc2 (append acc (list cmd)))) ((acc2 (append acc (list cmd))))
(cond (cond
((match-kw "unless")
(let
((cnd (parse-expr)))
(cl-collect
(append
acc
(list
(list (quote if) (list (quote no) cnd) cmd))))))
((match-kw "then") ((match-kw "then")
(cl-collect (append acc2 (list (quote __then__))))) (cl-collect (append acc2 (list (quote __then__)))))
((and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val))) ((and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val)))

View File

@@ -48,11 +48,17 @@
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms)))) (define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
;; Wait for CSS transitions/animations to settle on an element. ;; Wait for CSS transitions/animations to settle on an element.
(define (begin
hs-wait-for (define
(fn hs-wait-for
(target event-name) (fn
(perform (list (quote io-wait-event) target event-name)))) (target event-name)
(perform (list (quote io-wait-event) target event-name))))
(define
hs-wait-for-or
(fn
(target event-name timeout-ms)
(perform (list (quote io-wait-event) target event-name timeout-ms)))))
;; ── Class manipulation ────────────────────────────────────────── ;; ── Class manipulation ──────────────────────────────────────────

View File

@@ -13004,7 +13004,7 @@ end")
(dom-append (dom-body) _el-div) (dom-append (dom-body) _el-div)
(hs-activate! _el-div) (hs-activate! _el-div)
(dom-dispatch _el-div "click" nil) (dom-dispatch _el-div "click" nil)
(dom-dispatch _el-div "foo" nil) (dom-dispatch _el-div "foo" {:bar "bar"})
(assert= (dom-text-content _el-div) "bar") (assert= (dom-text-content _el-div) "bar")
)) ))
(deftest "can wait on event" (deftest "can wait on event"
@@ -13070,7 +13070,7 @@ end")
(dom-append (dom-body) _el-div) (dom-append (dom-body) _el-div)
(hs-activate! _el-div) (hs-activate! _el-div)
(dom-dispatch _el-div "click" nil) (dom-dispatch _el-div "click" nil)
(dom-dispatch _el-div "foo" nil) (dom-dispatch _el-div "foo" "hyperscript is hyper cool")
(assert= (dom-text-content _el-div) "hyperscript is hyper cool") (assert= (dom-text-content _el-div) "hyperscript is hyper cool")
)) ))
) )

View File

@@ -341,7 +341,23 @@ globalThis._driveAsync=function driveAsync(r,d){d=d||0;if(d>500||!r||!r.suspende
else if(opName==='io-parse-json'){const resp=items&&items[1];try{doResume(JSON.parse(typeof resp==='string'?resp:resp&&resp._json?resp._json:'{}'));}catch(e){doResume(null);}} else if(opName==='io-parse-json'){const resp=items&&items[1];try{doResume(JSON.parse(typeof resp==='string'?resp:resp&&resp._json?resp._json:'{}'));}catch(e){doResume(null);}}
else if(opName==='io-parse-html'){const frag=new El('fragment');frag.nodeType=11;doResume(frag);} else if(opName==='io-parse-html'){const frag=new El('fragment');frag.nodeType=11;doResume(frag);}
else if(opName==='io-settle')doResume(null); else if(opName==='io-settle')doResume(null);
else if(opName==='io-wait-event')doResume(null); else if(opName==='io-wait-event'){
const target=items&&items[1];
const evName=typeof items[2]==='string'?items[2]:'';
const timeout=items&&items.length>3?items[3]:undefined;
if(typeof timeout==='number'){
// `wait for EV or Nms` — timeout wins immediately in the mock (tests use 0ms)
doResume(null);
} else if(target && target instanceof El && evName){
const handler=function(ev){
target.removeEventListener(evName,handler);
doResume(ev);
};
target.addEventListener(evName,handler);
} else {
doResume(null);
}
}
else if(opName==='io-transition')doResume(null); else if(opName==='io-transition')doResume(null);
}; };

View File

@@ -783,6 +783,25 @@ def _window_setup_ops(assign_body):
return out return out
def _extract_detail_expr(opts_src):
"""Extract `detail: ...` from an event options block like `, { detail: X }`.
Returns an SX expression string, defaulting to `nil`."""
if not opts_src:
return 'nil'
# Plain string detail
dm = re.search(r'detail:\s*"([^"]*)"', opts_src)
if dm:
return f'"{dm.group(1)}"'
# Simple object detail: { k: "v", k2: "v2", ... } (string values only)
dm = re.search(r'detail:\s*\{([^{}]*)\}', opts_src)
if dm:
pairs = re.findall(r'(\w+):\s*"([^"]*)"', dm.group(1))
if pairs:
items = ' '.join(f':{k} "{v}"' for k, v in pairs)
return '{' + items + '}'
return 'nil'
def parse_dev_body(body, elements, var_names): def parse_dev_body(body, elements, var_names):
"""Parse Playwright test body into ordered SX ops. """Parse Playwright test body into ordered SX ops.
@@ -950,13 +969,15 @@ def parse_dev_body(body, elements, var_names):
m = re.match( m = re.match(
r"evaluate\(\s*\(\)\s*=>\s*document\.querySelector\(\s*(['\"])([^'\"]+)\1\s*\)" r"evaluate\(\s*\(\)\s*=>\s*document\.querySelector\(\s*(['\"])([^'\"]+)\1\s*\)"
r"\.dispatchEvent\(\s*new\s+(?:Custom)?Event\(\s*(['\"])([^'\"]+)\3" r"\.dispatchEvent\(\s*new\s+(?:Custom)?Event\(\s*(['\"])([^'\"]+)\3"
r"(?:\s*,\s*[^)]*)?\s*\)\s*\)\s*\)\s*$", r"(\s*,\s*\{.*\})?\s*\)\s*\)\s*\)\s*$",
stmt_na, re.DOTALL, stmt_na, re.DOTALL,
) )
if m and seen_html: if m and seen_html:
sel = re.sub(r'^#work-area\s+', '', m.group(2)) sel = re.sub(r'^#work-area\s+', '', m.group(2))
target = selector_to_sx(sel, elements, var_names) target = selector_to_sx(sel, elements, var_names)
ops.append(f'(dom-dispatch {target} "{m.group(4)}" nil)') opts = m.group(5) or ''
detail_expr = _extract_detail_expr(opts)
ops.append(f'(dom-dispatch {target} "{m.group(4)}" {detail_expr})')
continue continue
# evaluate(() => { const e = new Event(NAME, {...}); document.querySelector(SEL).dispatchEvent(e); }) # evaluate(() => { const e = new Event(NAME, {...}); document.querySelector(SEL).dispatchEvent(e); })
@@ -964,15 +985,17 @@ def parse_dev_body(body, elements, var_names):
m = re.match( m = re.match(
r"evaluate\(\s*\(\)\s*=>\s*\{\s*" r"evaluate\(\s*\(\)\s*=>\s*\{\s*"
r"const\s+(\w+)\s*=\s*new\s+(?:Custom)?Event\(\s*(['\"])([^'\"]+)\2" r"const\s+(\w+)\s*=\s*new\s+(?:Custom)?Event\(\s*(['\"])([^'\"]+)\2"
r"(?:\s*,\s*\{[^}]*\})?\s*\)\s*;\s*" r"(\s*,\s*\{[^}]*\})?\s*\)\s*;\s*"
r"document\.querySelector\(\s*(['\"])([^'\"]+)\4\s*\)" r"document\.querySelector\(\s*(['\"])([^'\"]+)\5\s*\)"
r"\.dispatchEvent\(\s*\1\s*\)\s*;?\s*\}\s*\)\s*$", r"\.dispatchEvent\(\s*\1\s*\)\s*;?\s*\}\s*\)\s*$",
stmt_na, re.DOTALL, stmt_na, re.DOTALL,
) )
if m and seen_html: if m and seen_html:
sel = re.sub(r'^#work-area\s+', '', m.group(5)) sel = re.sub(r'^#work-area\s+', '', m.group(6))
target = selector_to_sx(sel, elements, var_names) target = selector_to_sx(sel, elements, var_names)
ops.append(f'(dom-dispatch {target} "{m.group(3)}" nil)') opts = m.group(4) or ''
detail_expr = _extract_detail_expr(opts)
ops.append(f'(dom-dispatch {target} "{m.group(3)}" {detail_expr})')
continue continue
# evaluate(() => document.getElementById(ID).METHOD()) — generic # evaluate(() => document.getElementById(ID).METHOD()) — generic