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

HS: MutationObserver mock + on mutation dispatch (+7 tests)

Browse Source 
Parser: parse-on-feat now consumes `of FILTER` after `mutation` event-name,
where FILTER is `attributes`/`childList`/`characterData` ident or `@a [or @b]*`
attr-token chain. Emits :of-filter dict on parts. Compiler: scan-on threads
of-filter-info; mutation event-name emits `(do (hs-on …) (hs-on-mutation-attach!
TARGET MODE ATTRS))`. Runtime: hs-on-mutation-attach! constructs a real
MutationObserver with config matched to filter and dispatches "mutation" event
with records detail. Runner: HsMutationObserver mock with global registry;
prototype hooks on El.setAttribute/appendChild/removeChild/_setInnerHTML fire
matching observers synchronously, with __hsMutationActive guard preventing
recursion. Generator: dropped 7 mutation tests from skip-list, added
evaluate(setAttribute) and evaluate(appendChild) body patterns.

hs-upstream-on: 36/70 → 43/70. Smoke 0-195 unchanged at 170/195.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-25 11:52:54 +00:00
parent 1340284bc8
commit 13e0254261
9 changed files with 560 additions and 261 deletions
Download Patch File Download Diff File Expand all files Collapse all files

87
lib/hyperscript/compiler.sx
View File

@@ -164,7 +164,8 @@
every?
catch-info
finally-info
having-info)
having-info
of-filter-info)
(cond
((<= (len items) 1)
(let
@@ -185,23 +186,44 @@
((handler (let ((uses-the-result? (fn (expr) (cond ((= expr (quote the-result)) true) ((list? expr) (some (fn (x) (uses-the-result? x)) expr)) (true false))))) (list (quote fn) (list (quote event)) (if (uses-the-result? wrapped-body) (list (quote let) (list (list (quote the-result) nil)) wrapped-body) wrapped-body)))))
(let
((on-call (if every? (list (quote hs-on-every) target event-name handler) (list (quote hs-on) target event-name handler))))
(if
(= event-name "intersection")
(list
(quote do)
on-call
(cond
((= event-name "mutation")
(list
(quote hs-on-intersection-attach!)
target
(if
having-info
(get having-info "margin")
nil)
(if
having-info
(get having-info "threshold")
nil)))
on-call)))))))))))
(quote do)
on-call
(list
(quote hs-on-mutation-attach!)
target
(if
of-filter-info
(get of-filter-info "type")
"any")
(if
of-filter-info
(let
((a (get of-filter-info "attrs")))
(if
a
(cons (quote list) a)
nil))
nil))))
((= event-name "intersection")
(list
(quote do)
on-call
(list
(quote
hs-on-intersection-attach!)
target
(if
having-info
(get having-info "margin")
nil)
(if
having-info
(get having-info "threshold")
nil))))
(true on-call))))))))))))
((= (first items) :from)
(scan-on
(rest (rest items))
@@ -210,7 +232,8 @@
every?
catch-info
finally-info
having-info))
having-info
of-filter-info))
((= (first items) :filter)
(scan-on
(rest (rest items))
@@ -219,7 +242,8 @@
every?
catch-info
finally-info
having-info))
having-info
of-filter-info))
((= (first items) :every)
(scan-on
(rest (rest items))
@@ -228,7 +252,8 @@
true
catch-info
finally-info
having-info))
having-info
of-filter-info))
((= (first items) :catch)
(scan-on
(rest (rest items))
@@ -237,7 +262,8 @@
every?
(nth items 1)
finally-info
having-info))
having-info
of-filter-info))
((= (first items) :finally)
(scan-on
(rest (rest items))
@@ -246,7 +272,8 @@
every?
catch-info
(nth items 1)
having-info))
having-info
of-filter-info))
((= (first items) :having)
(scan-on
(rest (rest items))
@@ -255,6 +282,17 @@
every?
catch-info
finally-info
(nth items 1)
of-filter-info))
((= (first items) :of-filter)
(scan-on
(rest (rest items))
source
filter
every?
catch-info
finally-info
having-info
(nth items 1)))
(true
(scan-on
@@ -264,8 +302,9 @@
every?
catch-info
finally-info
having-info)))))
(scan-on (rest parts) nil nil false nil nil nil)))))
having-info
of-filter-info)))))
(scan-on (rest parts) nil nil false nil nil nil nil)))))
(define
emit-send
(fn

87
lib/hyperscript/parser.sx
View File

@@ -2605,59 +2605,66 @@
(let
((event-name (parse-compound-event-name)))
(let
((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil)))
((of-filter (when (and (= event-name "mutation") (match-kw "of")) (cond ((and (= (tp-type) "ident") (or (= (tp-val) "attributes") (= (tp-val) "childList") (= (tp-val) "characterData"))) (let ((nm (tp-val))) (do (adv!) (dict "type" nm)))) ((= (tp-type) "attr") (let ((attrs (list (tp-val)))) (do (adv!) (define collect-or! (fn () (when (match-kw "or") (cond ((= (tp-type) "attr") (do (set! attrs (append attrs (list (tp-val)))) (adv!) (collect-or!))) (true (set! p (- p 1))))))) (collect-or!) (dict "type" "attrs" "attrs" attrs)))) (true nil)))))
(let
((source (if (match-kw "from") (parse-expr) nil)))
((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil)))
(let
((h-margin nil) (h-threshold nil))
(define
consume-having!
(fn
()
(cond
((and (= (tp-type) "ident") (= (tp-val) "having"))
(do
(adv!)
(cond
((and (= (tp-type) "ident") (= (tp-val) "margin"))
(do
(adv!)
(set! h-margin (parse-expr))
(consume-having!)))
((and (= (tp-type) "ident") (= (tp-val) "threshold"))
(do
(adv!)
(set! h-threshold (parse-expr))
(consume-having!)))
(true nil))))
(true nil))))
(consume-having!)
((source (if (match-kw "from") (parse-expr) nil)))
(let
((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
((h-margin nil) (h-threshold nil))
(define
consume-having!
(fn
()
(cond
((and (= (tp-type) "ident") (= (tp-val) "having"))
(do
(adv!)
(cond
((and (= (tp-type) "ident") (= (tp-val) "margin"))
(do
(adv!)
(set! h-margin (parse-expr))
(consume-having!)))
((and (= (tp-type) "ident") (= (tp-val) "threshold"))
(do
(adv!)
(set! h-threshold (parse-expr))
(consume-having!)))
(true nil))))
(true nil))))
(consume-having!)
(let
((body (parse-cmd-list)))
((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
(let
((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil))
(finally-clause
(if (match-kw "finally") (parse-cmd-list) nil)))
(match-kw "end")
((body (parse-cmd-list)))
(let
((parts (list (quote on) event-name)))
((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil))
(finally-clause
(if
(match-kw "finally")
(parse-cmd-list)
nil)))
(match-kw "end")
(let
((parts (if every? (append parts (list :every true)) parts)))
((parts (list (quote on) event-name)))
(let
((parts (if flt (append parts (list :filter flt)) parts)))
((parts (if every? (append parts (list :every true)) parts)))
(let
((parts (if source (append parts (list :from source)) parts)))
((parts (if flt (append parts (list :filter flt)) parts)))
(let
((parts (if having (append parts (list :having having)) parts)))
((parts (if source (append parts (list :from source)) parts)))
(let
((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
((parts (if of-filter (append parts (list :of-filter of-filter)) parts)))
(let
((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
((parts (if having (append parts (list :having having)) parts)))
(let
((parts (append parts (list body))))
parts))))))))))))))))))
((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
(let
((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
(let
((parts (append parts (list body))))
parts))))))))))))))))))))
(define
parse-init-feat
(fn

138
lib/hyperscript/runtime.sx
View File

@@ -82,14 +82,36 @@
observer)))))
;; Wait for CSS transitions/animations to settle on an element.
(define hs-init (fn (thunk) (thunk)))
(define
hs-on-mutation-attach!
(fn
(target mode attr-list)
(let
((cfg-attributes (or (= mode "any") (= mode "attributes") (= mode "attrs")))
(cfg-childList (or (= mode "any") (= mode "childList")))
(cfg-characterData (or (= mode "any") (= mode "characterData"))))
(let
((opts (dict "attributes" cfg-attributes "childList" cfg-childList "characterData" cfg-characterData "subtree" true)))
(when
(and (= mode "attrs") attr-list)
(dict-set! opts "attributeFilter" attr-list))
(let
((cb (fn (records observer) (dom-dispatch target "mutation" (dict "records" records)))))
(let
((observer (host-new "MutationObserver" cb)))
(host-call observer "observe" target opts)
observer))))))
;; ── Class manipulation ──────────────────────────────────────────
;; Toggle a single class on an element.
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
(define hs-init (fn (thunk) (thunk)))
;; Toggle between two classes — exactly one is active at a time.
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
;; Take a class from siblings — add to target, remove from others.
;; (hs-take! target cls) — like radio button class behavior
(begin
(define
hs-wait-for
@@ -102,21 +124,20 @@
(target event-name timeout-ms)
(perform (list (quote io-wait-event) target event-name timeout-ms)))))
;; Take a class from siblings — add to target, remove from others.
;; (hs-take! target cls) — like radio button class behavior
(define hs-settle (fn (target) (perform (list (quote io-settle) target))))
;; ── DOM insertion ───────────────────────────────────────────────
;; Put content at a position relative to a target.
;; pos: "into" | "before" | "after"
(define
hs-toggle-class!
(fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
(define hs-settle (fn (target) (perform (list (quote io-settle) target))))
;; ── Navigation / traversal ──────────────────────────────────────
;; Navigate to a URL.
(define
hs-toggle-class!
(fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
;; Find next sibling matching a selector (or any sibling).
(define
hs-toggle-between!
(fn
@@ -126,7 +147,7 @@
(do (dom-remove-class target cls1) (dom-add-class target cls2))
(do (dom-remove-class target cls2) (dom-add-class target cls1)))))
;; Find next sibling matching a selector (or any sibling).
;; Find previous sibling matching a selector.
(define
hs-toggle-style!
(fn
@@ -150,7 +171,7 @@
(dom-set-style target prop "hidden")
(dom-set-style target prop "")))))))
;; Find previous sibling matching a selector.
;; First element matching selector within a scope.
(define
hs-toggle-style-between!
(fn
@@ -162,7 +183,7 @@
(dom-set-style target prop val2)
(dom-set-style target prop val1)))))
;; First element matching selector within a scope.
;; Last element matching selector.
(define
hs-toggle-style-cycle!
(fn
@@ -183,7 +204,7 @@
(true (find-next (rest remaining))))))
(dom-set-style target prop (find-next vals)))))
;; Last element matching selector.
;; First/last within a specific scope.
(define
hs-take!
(fn
@@ -223,7 +244,6 @@
(dom-set-attr target name attr-val)
(dom-set-attr target name ""))))))))
;; First/last within a specific scope.
(begin
(define
hs-element?
@@ -335,6 +355,9 @@
(dom-insert-adjacent-html target "beforeend" value)
(hs-boot-subtree! target)))))))))
;; ── Iteration ───────────────────────────────────────────────────
;; Repeat a thunk N times.
(define
hs-add-to!
(fn
@@ -347,9 +370,7 @@
(append target (list value))))
(true (do (host-call target "push" value) target)))))
;; ── Iteration ───────────────────────────────────────────────────
;; Repeat a thunk N times.
;; Repeat forever (until break — relies on exception/continuation).
(define
hs-remove-from!
(fn
@@ -359,7 +380,10 @@
(filter (fn (x) (not (= x value))) target)
(host-call target "splice" (host-call target "indexOf" value) 1))))
;; 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"
(define
hs-splice-at!
(fn
@@ -383,10 +407,10 @@
(host-call target "splice" i 1))))
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-index
(fn
@@ -398,10 +422,10 @@
((string? obj) (nth obj key))
(true (host-get obj key)))))
;; ── 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-put-at!
(fn
@@ -423,10 +447,11 @@
((= pos "start") (host-call target "unshift" value)))
target)))))))
;; ── 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-dict-without
(fn
@@ -447,27 +472,27 @@
(host-call (host-global "Reflect") "deleteProperty" out key)
out)))))
;; ── 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-set-on!
(fn
(props target)
(for-each (fn (k) (host-set! target k (get props k))) (keys props))))
;; ── Measurement ─────────────────────────────────────────────────
;; Measure an element's bounding rect, store as local variables.
;; Returns a dict with x, y, width, height, top, left, right, bottom.
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
;; 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-navigate! (fn (url) (perform (list (quote io-navigate) url))))
;; ── Transition ──────────────────────────────────────────────────
;; Transition a CSS property to a value, optionally with duration.
;; (hs-transition target prop value duration)
(define
hs-ask
(fn
@@ -476,11 +501,6 @@
((w (host-global "window")))
(if w (host-call w "prompt" msg) nil))))
;; ── Transition ──────────────────────────────────────────────────
;; Transition a CSS property to a value, optionally with duration.
;; (hs-transition target prop value duration)
(define
hs-answer
(fn
@@ -634,6 +654,10 @@
hs-query-all
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
(define
hs-query-all-in
(fn
@@ -643,25 +667,21 @@
(hs-query-all sel)
(host-call target "querySelectorAll" sel))))
(define
hs-list-set
(fn
(lst idx val)
(append (take lst idx) (cons val (drop lst (+ idx 1))))))
(define
hs-to-number
(fn (v) (if (number? v) v (or (parse-number (str v)) 0))))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
(define
hs-to-number
(fn (v) (if (number? v) v (or (parse-number (str v)) 0))))
;; DOM query stub — sandbox returns empty list
(define
hs-query-first
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
;; DOM query stub — sandbox returns empty list
;; Method dispatch — obj.method(args)
(define
hs-query-last
(fn
@@ -669,11 +689,11 @@
(let
((all (dom-query-all (dom-body) sel)))
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
;; Method dispatch — obj.method(args)
(define hs-first (fn (scope sel) (dom-query-all scope sel)))
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
(define hs-first (fn (scope sel) (dom-query-all scope sel)))
;; Property-based is — check obj.key truthiness
(define
hs-last
(fn
@@ -681,7 +701,7 @@
(let
((all (dom-query-all scope sel)))
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
;; Property-based is — check obj.key truthiness
;; Array slicing (inclusive both ends)
(define
hs-repeat-times
(fn
@@ -699,7 +719,7 @@
((= signal "hs-continue") (do-repeat (+ i 1)))
(true (do-repeat (+ i 1))))))))
(do-repeat 0)))
;; Array slicing (inclusive both ends)
;; Collection: sorted by
(define
hs-repeat-forever
(fn
@@ -715,7 +735,7 @@
((= signal "hs-continue") (do-forever))
(true (do-forever))))))
(do-forever)))
;; Collection: sorted by
;; Collection: sorted by descending
(define
hs-repeat-while
(fn
@@ -728,7 +748,7 @@
((= signal "hs-break") nil)
((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
(true (hs-repeat-while cond-fn thunk)))))))
;; Collection: sorted by descending
;; Collection: split by
(define
hs-repeat-until
(fn
@@ -740,7 +760,7 @@
((= signal "hs-continue")
(if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
(true (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))))))
;; Collection: split by
;; Collection: joined by
(define
hs-for-each
(fn
@@ -760,7 +780,7 @@
((= signal "hs-continue") (do-loop (rest remaining)))
(true (do-loop (rest remaining))))))))
(do-loop items))))
;; Collection: joined by
(begin
(define
hs-append