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

HS take command: class/attr with+giving, attr removal from scope, giving keyword

Browse Source 
- tokenizer: add 'giving' as keyword so parse-take-cmd can detect it.
- parser.sx parse-take-cmd: loop over 'with <class>' / 'giving <class>' /
  'from <sel>' / 'for <tgt>' clauses in any order for both the class and
  attribute cases. Emits uniform (take! kind name from-sel for-tgt
  attr-val with-val) 7-slot AST.
- compiler emit-take: pass with-cls for the class case through to runtime.
- runtime hs-take!: with a class 'with' replacement, toggle both classes
  across scope + target. For attribute take, always strip the attr from
  the scope 'others' (setting to with-val if given, otherwise removing).
- generator pw-body: translate evaluate(() => document.querySelector(s).
  click()) and .dispatchEvent(new Event('name', …)) into dom-dispatch ops
  so bubbling-click assertions in 'parent takes…' tests work.
- generator toHaveClass: strip JS regex word-boundaries (\\b) from the
  expected class name.
- shared/static/wasm/sx/dom.sx: dom-child-list / dom-child-nodes mirror
  the dom-query-all SX-list passthrough — childNodes arrives pre-SXified.

Net: take 6→15 (100%), remove 16→17, fetch 11→15.

🤖 Generated with [Claude Code](https://claude.com/claude-code)

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-23 16:51:17 +00:00
parent 3528cef35a
commit 601fdc1c34
11 changed files with 356 additions and 143 deletions
Download Patch File Download Diff File Expand all files Collapse all files

41
lib/hyperscript/compiler.sx
View File

@@ -1621,18 +1621,35 @@
((nil? from-sel) nil)
((and (list? from-sel) (= (first from-sel) (quote query)))
(list (quote hs-query-all) (nth from-sel 1)))
(true (hs-to-sx from-sel)))))
(if
(and (= kind "attr") (or attr-val with-val))
(list
(quote hs-take!)
target
kind
name
scope
attr-val
(if with-val (hs-to-sx with-val) nil))
(list (quote hs-take!) target kind name scope)))))
(true (hs-to-sx from-sel))))
(with-sx
(if
with-val
(if
(string? with-val)
with-val
(hs-to-sx with-val))
nil)))
(cond
((and (= kind "attr") (or attr-val with-val))
(list
(quote hs-take!)
target
kind
name
scope
attr-val
with-sx))
((and (= kind "class") with-val)
(list
(quote hs-take!)
target
kind
name
scope
nil
with-sx))
(true (list (quote hs-take!) target kind name scope))))))
((= head (quote make)) (emit-make ast))
((= head (quote install))
(cons (quote hs-install) (map hs-to-sx (rest ast))))

118
lib/hyperscript/parser.sx
View File

@@ -1648,48 +1648,94 @@
((collect (fn () (when (= (tp-type) "class") (let ((v (tp-val))) (adv!) (set! classes (append classes (list v))) (collect))))))
(collect)
(let
((from-sel (if (match-kw "from") (parse-expr) nil)))
(let
((for-tgt (if (match-kw "for") (parse-expr) nil)))
(if
(= (len classes) 1)
(list
(quote take!)
"class"
(first classes)
from-sel
for-tgt)
(cons
(quote do)
(map
(fn
(cls)
(list
(quote take!)
"class"
cls
from-sel
for-tgt))
classes))))))))
((with-cls nil) (from-sel nil) (for-tgt nil))
(define
parse-cls-clauses
(fn
()
(cond
((and (nil? with-cls) (match-kw "with") (= (tp-type) "class"))
(do
(set! with-cls (tp-val))
(adv!)
(parse-cls-clauses)))
((and (nil? with-cls) (match-kw "giving") (= (tp-type) "class"))
(do
(set! with-cls (tp-val))
(adv!)
(parse-cls-clauses)))
((and (nil? from-sel) (match-kw "from"))
(do
(set! from-sel (parse-expr))
(parse-cls-clauses)))
((and (nil? for-tgt) (match-kw "for"))
(do
(set! for-tgt (parse-expr))
(parse-cls-clauses)))
(true nil))))
(parse-cls-clauses)
(if
(= (len classes) 1)
(list
(quote take!)
"class"
(first classes)
from-sel
for-tgt
nil
with-cls)
(cons
(quote do)
(map
(fn
(cls)
(list
(quote take!)
"class"
cls
from-sel
for-tgt
nil
with-cls))
classes)))))))
((= (tp-type) "attr")
(let
((attr-name (get (adv!) "value")))
(let
((attr-val (if (and (= (tp-type) "op") (= (tp-val) "=")) (do (adv!) (get (adv!) "value")) nil)))
(let
((with-val (if (match-kw "with") (parse-expr) nil)))
(let
((from-sel (if (match-kw "from") (parse-expr) nil)))
(let
((for-tgt (if (match-kw "for") (parse-expr) nil)))
(list
(quote take!)
"attr"
attr-name
from-sel
for-tgt
attr-val
with-val)))))))
((with-val nil) (from-sel nil) (for-tgt nil))
(define
parse-attr-clauses
(fn
()
(cond
((and (nil? with-val) (match-kw "with"))
(do
(set! with-val (parse-expr))
(parse-attr-clauses)))
((and (nil? with-val) (match-kw "giving"))
(do
(set! with-val (parse-expr))
(parse-attr-clauses)))
((and (nil? from-sel) (match-kw "from"))
(do
(set! from-sel (parse-expr))
(parse-attr-clauses)))
((and (nil? for-tgt) (match-kw "for"))
(do
(set! for-tgt (parse-expr))
(parse-attr-clauses)))
(true nil))))
(parse-attr-clauses)
(list
(quote take!)
"attr"
attr-name
from-sel
for-tgt
attr-val
with-val)))))
(true nil))))
(define
parse-pick-cmd

28
lib/hyperscript/runtime.sx
View File

@@ -146,16 +146,32 @@
((els (if scope (if (list? scope) scope (list scope)) (let ((parent (dom-parent target))) (if parent (dom-child-list parent) (list))))))
(if
(= kind "class")
(do
(for-each (fn (el) (dom-remove-class el name)) els)
(dom-add-class target name))
(let
((with-cls (if (> (len extra) 1) (nth extra 1) nil)))
(do
(for-each
(fn
(el)
(do
(dom-remove-class el name)
(when with-cls (dom-add-class el with-cls))))
els)
(dom-add-class target name)
(when with-cls (dom-remove-class target with-cls))))
(let
((attr-val (if (> (len extra) 0) (first extra) nil))
(with-val (if (> (len extra) 1) (nth extra 1) nil)))
(do
(when
with-val
(for-each (fn (el) (dom-set-attr el name with-val)) els))
(for-each
(fn
(el)
(when
(not (= el target))
(if
with-val
(dom-set-attr el name with-val)
(dom-remove-attr el name))))
els)
(if
attr-val
(dom-set-attr target name attr-val)

3
lib/hyperscript/tokenizer.sx
View File

@@ -184,7 +184,8 @@
"blur"
"dom"
"morph"
"using"))
"using"
"giving"))
(define hs-keyword? (fn (word) (some (fn (k) (= k word)) hs-keywords)))

68
shared/static/wasm/sx/dom.sx
View File

@@ -308,42 +308,54 @@
(fn
(el)
"Return child nodes as an SX list."
(if
el
(let
((nl (host-get el "childNodes"))
(n (host-get nl "length"))
(result (list)))
(cond
((nil? el) (list))
(true
(let
loop
((i 0))
(when
(< i n)
(append! result (host-call nl "item" i))
(loop (+ i 1))))
result)
(list))))
((nl (host-get el "childNodes")))
(cond
((nil? nl) (list))
((list? nl) nl)
(true
(let
((n (host-get nl "length")) (result (list)))
(when
(not (nil? n))
(let
loop
((i 0))
(when
(< i n)
(append! result (host-call nl "item" i))
(loop (+ i 1)))))
result))))))))
(define dom-is-fragment? (fn (el) (= (host-get el "nodeType") 11)))
(define
dom-child-nodes
(fn
(el)
"Return child nodes as an SX list."
(if
el
(let
((nl (host-get el "childNodes"))
(n (host-get nl "length"))
(result (list)))
(cond
((nil? el) (list))
(true
(let
loop
((i 0))
(when
(< i n)
(append! result (host-call nl "item" i))
(loop (+ i 1))))
result)
(list))))
((nl (host-get el "childNodes")))
(cond
((nil? nl) (list))
((list? nl) nl)
(true
(let
((n (host-get nl "length")) (result (list)))
(when
(not (nil? n))
(let
loop
((i 0))
(when
(< i n)
(append! result (host-call nl "item" i))
(loop (+ i 1)))))
result))))))))
(define
dom-remove-children-after
(fn

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

@@ -1621,18 +1621,35 @@
((nil? from-sel) nil)
((and (list? from-sel) (= (first from-sel) (quote query)))
(list (quote hs-query-all) (nth from-sel 1)))
(true (hs-to-sx from-sel)))))
(if
(and (= kind "attr") (or attr-val with-val))
(list
(quote hs-take!)
target
kind
name
scope
attr-val
(if with-val (hs-to-sx with-val) nil))
(list (quote hs-take!) target kind name scope)))))
(true (hs-to-sx from-sel))))
(with-sx
(if
with-val
(if
(string? with-val)
with-val
(hs-to-sx with-val))
nil)))
(cond
((and (= kind "attr") (or attr-val with-val))
(list
(quote hs-take!)
target
kind
name
scope
attr-val
with-sx))
((and (= kind "class") with-val)
(list
(quote hs-take!)
target
kind
name
scope
nil
with-sx))
(true (list (quote hs-take!) target kind name scope))))))
((= head (quote make)) (emit-make ast))
((= head (quote install))
(cons (quote hs-install) (map hs-to-sx (rest ast))))

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

@@ -1648,48 +1648,94 @@
((collect (fn () (when (= (tp-type) "class") (let ((v (tp-val))) (adv!) (set! classes (append classes (list v))) (collect))))))
(collect)
(let
((from-sel (if (match-kw "from") (parse-expr) nil)))
(let
((for-tgt (if (match-kw "for") (parse-expr) nil)))
(if
(= (len classes) 1)
(list
(quote take!)
"class"
(first classes)
from-sel
for-tgt)
(cons
(quote do)
(map
(fn
(cls)
(list
(quote take!)
"class"
cls
from-sel
for-tgt))
classes))))))))
((with-cls nil) (from-sel nil) (for-tgt nil))
(define
parse-cls-clauses
(fn
()
(cond
((and (nil? with-cls) (match-kw "with") (= (tp-type) "class"))
(do
(set! with-cls (tp-val))
(adv!)
(parse-cls-clauses)))
((and (nil? with-cls) (match-kw "giving") (= (tp-type) "class"))
(do
(set! with-cls (tp-val))
(adv!)
(parse-cls-clauses)))
((and (nil? from-sel) (match-kw "from"))
(do
(set! from-sel (parse-expr))
(parse-cls-clauses)))
((and (nil? for-tgt) (match-kw "for"))
(do
(set! for-tgt (parse-expr))
(parse-cls-clauses)))
(true nil))))
(parse-cls-clauses)
(if
(= (len classes) 1)
(list
(quote take!)
"class"
(first classes)
from-sel
for-tgt
nil
with-cls)
(cons
(quote do)
(map
(fn
(cls)
(list
(quote take!)
"class"
cls
from-sel
for-tgt
nil
with-cls))
classes)))))))
((= (tp-type) "attr")
(let
((attr-name (get (adv!) "value")))
(let
((attr-val (if (and (= (tp-type) "op") (= (tp-val) "=")) (do (adv!) (get (adv!) "value")) nil)))
(let
((with-val (if (match-kw "with") (parse-expr) nil)))
(let
((from-sel (if (match-kw "from") (parse-expr) nil)))
(let
((for-tgt (if (match-kw "for") (parse-expr) nil)))
(list
(quote take!)
"attr"
attr-name
from-sel
for-tgt
attr-val
with-val)))))))
((with-val nil) (from-sel nil) (for-tgt nil))
(define
parse-attr-clauses
(fn
()
(cond
((and (nil? with-val) (match-kw "with"))
(do
(set! with-val (parse-expr))
(parse-attr-clauses)))
((and (nil? with-val) (match-kw "giving"))
(do
(set! with-val (parse-expr))
(parse-attr-clauses)))
((and (nil? from-sel) (match-kw "from"))
(do
(set! from-sel (parse-expr))
(parse-attr-clauses)))
((and (nil? for-tgt) (match-kw "for"))
(do
(set! for-tgt (parse-expr))
(parse-attr-clauses)))
(true nil))))
(parse-attr-clauses)
(list
(quote take!)
"attr"
attr-name
from-sel
for-tgt
attr-val
with-val)))))
(true nil))))
(define
parse-pick-cmd

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

@@ -146,16 +146,32 @@
((els (if scope (if (list? scope) scope (list scope)) (let ((parent (dom-parent target))) (if parent (dom-child-list parent) (list))))))
(if
(= kind "class")
(do
(for-each (fn (el) (dom-remove-class el name)) els)
(dom-add-class target name))
(let
((with-cls (if (> (len extra) 1) (nth extra 1) nil)))
(do
(for-each
(fn
(el)
(do
(dom-remove-class el name)
(when with-cls (dom-add-class el with-cls))))
els)
(dom-add-class target name)
(when with-cls (dom-remove-class target with-cls))))
(let
((attr-val (if (> (len extra) 0) (first extra) nil))
(with-val (if (> (len extra) 1) (nth extra 1) nil)))
(do
(when
with-val
(for-each (fn (el) (dom-set-attr el name with-val)) els))
(for-each
(fn
(el)
(when
(not (= el target))
(if
with-val
(dom-set-attr el name with-val)
(dom-remove-attr el name))))
els)
(if
attr-val
(dom-set-attr target name attr-val)

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

@@ -184,7 +184,8 @@
"blur"
"dom"
"morph"
"using"))
"using"
"giving"))
(define hs-keyword? (fn (word) (some (fn (k) (= k word)) hs-keywords)))

19
spec/tests/test-hyperscript-behavioral.sx
View File

@@ -349,7 +349,9 @@
(dom-append _el-div _el-btn1)
(hs-activate! _el-div)
(host-set! (host-global "window") "clicks" 0)
(dom-dispatch (dom-query-by-id "btn1") "click" nil)
(dom-dispatch _el-div "click" nil)
(dom-dispatch (dom-query-by-id "btn1") "click" nil)
))
(deftest "append to undefined ignores the undefined"
(hs-cleanup!)
@@ -1987,6 +1989,7 @@
(dom-append (dom-body) _el-target)
(dom-append (dom-body) _el-other)
(hs-activate! _el-target)
(dom-dispatch (dom-query-by-id "other") "click" nil)
))
(deftest "can remove class by id"
(hs-cleanup!)
@@ -10177,6 +10180,7 @@
(let ((_el-untilTest (dom-create-element "div")))
(dom-set-attr _el-untilTest "id" "untilTest")
(dom-append (dom-body) _el-untilTest)
(dom-dispatch (dom-query-by-id "untilTest") "click" nil)
))
(deftest "until keyword works"
(hs-cleanup!)
@@ -11434,6 +11438,7 @@
(dom-append _el-div _el-d2)
(dom-append _el-div _el-d3)
(hs-activate! _el-div)
(dom-dispatch (dom-query-by-id "d2") "click" nil)
(assert (not (dom-has-class? (dom-query-by-id "d1") "foo")))
(assert (dom-has-class? (dom-query-by-id "d2") "foo"))
(assert (not (dom-has-class? (dom-query-by-id "d3") "foo")))
@@ -11454,6 +11459,7 @@
(dom-append _el-div _el-d2)
(dom-append _el-div _el-d3)
(hs-activate! _el-div)
(dom-dispatch (dom-query-by-id "d2") "click" nil)
(assert (not (dom-has-attr? (dom-query-by-id "d1") "data-foo")))
(assert= (dom-get-attr (dom-query-by-id "d2") "data-foo") "")
(assert (not (dom-has-attr? (dom-query-by-id "d3") "data-foo")))
@@ -11474,8 +11480,8 @@
(hs-activate! _el-div1)
(dom-dispatch (nth (dom-query-all (dom-body) "div") 1) "click" nil)
(assert (dom-has-class? _el-div "unselected"))
(assert (not (dom-has-class? _el-div "\bselected\b")))
(assert (dom-has-class? (nth (dom-query-all (dom-body) "div") 1) "\bselected\b"))
(assert (not (dom-has-class? _el-div "selected")))
(assert (dom-has-class? (nth (dom-query-all (dom-body) "div") 1) "selected"))
(assert (not (dom-has-class? (nth (dom-query-all (dom-body) "div") 1) "unselected")))
(assert (dom-has-class? (nth (dom-query-all (dom-body) "div") 2) "unselected"))
))
@@ -11492,9 +11498,9 @@
(dom-append (dom-body) _el-div2)
(hs-activate! _el-div1)
(dom-dispatch (nth (dom-query-all (dom-body) "div") 1) "click" nil)
(assert (not (dom-has-class? _el-div "\bselected\b")))
(assert (not (dom-has-class? _el-div "selected")))
(assert (dom-has-class? _el-div "unselected"))
(assert (dom-has-class? (nth (dom-query-all (dom-body) "div") 1) "\bselected\b"))
(assert (dom-has-class? (nth (dom-query-all (dom-body) "div") 1) "selected"))
(assert (not (dom-has-class? (nth (dom-query-all (dom-body) "div") 1) "unselected")))
(assert (dom-has-class? (nth (dom-query-all (dom-body) "div") 2) "unselected"))
))
@@ -12610,6 +12616,7 @@ end")
(assert (not (dom-has-class? (dom-query "div:nth-of-type(2)") "foo")))
(dom-dispatch (dom-query "div:nth-of-type(2)") "click" nil)
(assert (dom-has-class? (dom-query "div:nth-of-type(2)") "foo"))
(dom-dispatch (dom-query-by-id "d1") "foo" nil)
(assert (not (dom-has-class? (dom-query "div:nth-of-type(2)") "foo")))
))
(deftest "can toggle visibility"
@@ -12980,6 +12987,7 @@ end")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
(dom-dispatch _el-div "click" nil)
(dom-dispatch _el-div "foo" nil)
(assert= (dom-text-content _el-div) "bar")
))
(deftest "can wait on event"
@@ -12991,6 +12999,7 @@ end")
(dom-dispatch _el-div "click" nil)
(assert (dom-has-class? _el-div "foo"))
(assert (not (dom-has-class? _el-div "bar")))
(dom-dispatch _el-div "foo" nil)
(assert (dom-has-class? _el-div "bar"))
))
(deftest "can wait on event on another element"
@@ -13004,6 +13013,7 @@ end")
(dom-dispatch (dom-query "div:nth-of-type(2)") "click" nil)
(assert (dom-has-class? (dom-query "div:nth-of-type(2)") "foo"))
(assert (not (dom-has-class? (dom-query "div:nth-of-type(2)") "bar")))
(dom-dispatch (dom-query-by-id "d2") "foo" nil)
(assert (dom-has-class? (dom-query "div:nth-of-type(2)") "bar"))
))
(deftest "can wait on event or timeout 1"
@@ -13043,6 +13053,7 @@ end")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
(dom-dispatch _el-div "click" nil)
(dom-dispatch _el-div "foo" nil)
(assert= (dom-text-content _el-div) "hyperscript is hyper cool")
))
)

32
tests/playwright/generate-sx-tests.py
View File

@@ -680,10 +680,14 @@ def pw_assertion_to_sx(target, negated, assert_type, args_str):
elif assert_type == 'toHaveClass':
cls = args[0] if args else ''
if not cls:
# Handle regex like /outer-clicked/
# Handle regex like /outer-clicked/ or /\bselected\b/
m = re.match(r'/(.+?)/', args_str)
if m:
cls = m.group(1)
# Strip JS regex anchors/word-boundaries — the class name itself is
# a bare ident, not a regex pattern.
cls = re.sub(r'\\b', '', cls)
cls = cls.strip('^$')
if negated:
return f'(assert (not (dom-has-class? {target} "{cls}")))'
return f'(assert (dom-has-class? {target} "{cls}"))'
@@ -897,6 +901,32 @@ def parse_dev_body(body, elements, var_names):
ops.append(f'(dom-set-inner-html {target} "{val}")')
continue
# evaluate(() => document.querySelector(SEL).click()) — dispatch click
# on the matched element (bubbles so ancestors see it too).
m = re.match(
r"evaluate\(\s*\(\)\s*=>\s*document\.querySelector\(\s*(['\"])([^'\"]+)\1\s*\)"
r"\.click\(\)\s*\)\s*$",
stmt_na, re.DOTALL,
)
if m and seen_html:
sel = re.sub(r'^#work-area\s+', '', m.group(2))
target = selector_to_sx(sel, elements, var_names)
ops.append(f'(dom-dispatch {target} "click" nil)')
continue
# evaluate(() => document.querySelector(SEL).dispatchEvent(new Event/CustomEvent(NAME…)))
m = re.match(
r"evaluate\(\s*\(\)\s*=>\s*document\.querySelector\(\s*(['\"])([^'\"]+)\1\s*\)"
r"\.dispatchEvent\(\s*new\s+(?:Custom)?Event\(\s*(['\"])([^'\"]+)\3"
r"(?:\s*,\s*[^)]*)?\s*\)\s*\)\s*\)\s*$",
stmt_na, re.DOTALL,
)
if m and seen_html:
sel = re.sub(r'^#work-area\s+', '', m.group(2))
target = selector_to_sx(sel, elements, var_names)
ops.append(f'(dom-dispatch {target} "{m.group(4)}" nil)')
continue
if not seen_html:
continue
if add_action(stmt_na):