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

HS: wait on event basics (+4 tests)

Browse Source 
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:
giles
2026-04-24 06:05:53 +00:00
parent e8a89a6ce2
commit f79f96c1c3
9 changed files with 248 additions and 133 deletions
Download Patch File Download Diff File Expand all files Collapse all files

118
lib/hyperscript/compiler.sx
View File

@@ -348,11 +348,30 @@
(fn
(ast)
(let
((event-name (nth ast 1)))
(if
(and (> (len ast) 2) (= (nth ast 2) :from))
(list (quote hs-wait-for) (hs-to-sx (nth ast 3)) event-name)
(list (quote hs-wait-for) (quote me) event-name)))))
((event-name (nth ast 1))
(has-from (and (> (len ast) 2) (= (nth ast 2) :from)))
(has-from-or
(and
(> (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
emit-transition
(fn
@@ -666,6 +685,16 @@
(let
((head (first ast)))
(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))
(list (quote hs-sender) (quote event)))
((= head (quote null-literal)) nil)
@@ -1500,47 +1529,50 @@
(hs-to-sx (nth ast 2)))))
((= head (quote do))
(let
((compiled (map hs-to-sx (rest ast))))
(if
(and
(> (len compiled) 1)
(some
((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))))
(let
((compiled (map hs-to-sx expanded)))
(if
(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
(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-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))
(body cmd)
(if
(and
(list? cmd)
(= (first cmd) (quote hs-fetch)))
(list
(quote begin)
(quote let)
(list (list (quote it) cmd))
(list
(quote set!)
(quote the-result)
(quote it))
body))
(list
(quote let)
(list (list (quote it) cmd))
body)))
(nth compiled (- (len compiled) 1))
(rest (reverse compiled)))
(cons (quote do) compiled))))
(quote begin)
(list
(quote set!)
(quote the-result)
(quote it))
body))
(list
(quote let)
(list (list (quote it) cmd))
body)))
(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-for)) (emit-wait-for ast))
((= head (quote log))