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

HS: logAll config (+1 test)

Browse Source 
Add `_hs-config-log-all` runtime flag + captured log list. When set
via `hs-set-log-all!`, `hs-activate!` pushes "hyperscript:init" onto
`_hs-log-captured` and mirrors to console.log. Covers cluster 30.

Generator side: eval-only path now detects the logAll body pattern
(`_hyperscript.config.logAll = true`) and emits a deftest that:

  - resets captured list
  - toggles log-all on
  - builds a div with `_="on click add .foo"` and `hs-boot-subtree!`s
  - asserts `(some string-contains? "hyperscript:")` over captured logs.

hs-upstream-core/bootstrap: 19/26 -> 20/26. Smoke 0-195: 164 -> 165.
This commit is contained in:
giles
2026-04-24 10:05:49 +00:00
parent eb587bb3d0
commit 64bcefffdc
6 changed files with 240 additions and 153 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
lib/hyperscript/integration.sx
View File

@@ -80,6 +80,7 @@
((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script"))) ((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script")))
(when (when
(and src (not (= src prev))) (and src (not (= src prev)))
(hs-log-event! "hyperscript:init")
(dom-set-data el "hs-script" src) (dom-set-data el "hs-script" src)
(dom-set-data el "hs-active" true) (dom-set-data el "hs-active" true)
(dom-set-attr el "data-hyperscript-powered" "true") (dom-set-attr el "data-hyperscript-powered" "true")

179
lib/hyperscript/runtime.sx
View File

@@ -12,14 +12,37 @@
;; Register an event listener. Returns unlisten function. ;; Register an event listener. Returns unlisten function.
;; (hs-on target event-name handler) → unlisten-fn ;; (hs-on target event-name handler) → unlisten-fn
(begin
(define _hs-config-log-all false)
(define _hs-log-captured (list))
(define
hs-set-log-all!
(fn (flag) (set! _hs-config-log-all (if flag true false))))
(define hs-get-log-captured (fn () _hs-log-captured))
(define
hs-clear-log-captured!
(fn () (begin (set! _hs-log-captured (list)) nil)))
(define
hs-log-event!
(fn
(msg)
(when
_hs-config-log-all
(begin
(set! _hs-log-captured (append _hs-log-captured (list msg)))
(host-call (host-global "console") "log" msg)
nil)))))
;; Register for every occurrence (no queuing — each fires independently).
;; Stock hyperscript queues by default; "every" disables queuing.
(define (define
hs-each hs-each
(fn (fn
(target action) (target action)
(if (list? target) (for-each action target) (action target)))) (if (list? target) (for-each action target) (action target))))
;; Register for every occurrence (no queuing — each fires independently). ;; Run an initializer function immediately.
;; Stock hyperscript queues by default; "every" disables queuing. ;; (hs-init thunk) — called at element boot time
(define (define
hs-on hs-on
(fn (fn
@@ -32,24 +55,25 @@
(dom-set-data target "hs-unlisteners" (append prev (list unlisten))) (dom-set-data target "hs-unlisteners" (append prev (list unlisten)))
unlisten)))) unlisten))))
;; Run an initializer function immediately.
;; (hs-init thunk) — called at element boot time
(define
hs-on-every
(fn (target event-name handler) (dom-listen target event-name handler)))
;; ── Async / timing ────────────────────────────────────────────── ;; ── Async / timing ──────────────────────────────────────────────
;; Wait for a duration in milliseconds. ;; Wait for a duration in milliseconds.
;; In hyperscript, wait is async-transparent — execution pauses. ;; In hyperscript, wait is async-transparent — execution pauses.
;; Here we use perform/IO suspension for true pause semantics. ;; Here we use perform/IO suspension for true pause semantics.
(define hs-init (fn (thunk) (thunk))) (define
hs-on-every
(fn (target event-name handler) (dom-listen target event-name handler)))
;; Wait for a DOM event on a target. ;; Wait for a DOM event on a target.
;; (hs-wait-for target event-name) — suspends until event fires ;; (hs-wait-for target event-name) — suspends until event fires
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms)))) (define hs-init (fn (thunk) (thunk)))
;; Wait for CSS transitions/animations to settle on an element. ;; Wait for CSS transitions/animations to settle on an element.
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
;; ── Class manipulation ──────────────────────────────────────────
;; Toggle a single class on an element.
(begin (begin
(define (define
hs-wait-for hs-wait-for
@@ -62,18 +86,19 @@
(target event-name timeout-ms) (target event-name timeout-ms)
(perform (list (quote io-wait-event) target event-name timeout-ms))))) (perform (list (quote io-wait-event) target event-name timeout-ms)))))
;; ── Class manipulation ────────────────────────────────────────── ;; Toggle between two classes — exactly one is active at a time.
;; Toggle a single class on an element.
(define hs-settle (fn (target) (perform (list (quote io-settle) target)))) (define hs-settle (fn (target) (perform (list (quote io-settle) target))))
;; Toggle between two classes — exactly one is active at a time. ;; Take a class from siblings — add to target, remove from others.
;; (hs-take! target cls) — like radio button class behavior
(define (define
hs-toggle-class! hs-toggle-class!
(fn (target cls) (host-call (host-get target "classList") "toggle" cls))) (fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
;; Take a class from siblings — add to target, remove from others. ;; ── DOM insertion ───────────────────────────────────────────────
;; (hs-take! target cls) — like radio button class behavior
;; Put content at a position relative to a target.
;; pos: "into" | "before" | "after"
(define (define
hs-toggle-between! hs-toggle-between!
(fn (fn
@@ -83,10 +108,9 @@
(do (dom-remove-class target cls1) (dom-add-class target cls2)) (do (dom-remove-class target cls1) (dom-add-class target cls2))
(do (dom-remove-class target cls2) (dom-add-class target cls1))))) (do (dom-remove-class target cls2) (dom-add-class target cls1)))))
;; ── DOM insertion ─────────────────────────────────────────────── ;; ── Navigation / traversal ──────────────────────────────────────
;; Put content at a position relative to a target. ;; Navigate to a URL.
;; pos: "into" | "before" | "after"
(define (define
hs-toggle-style! hs-toggle-style!
(fn (fn
@@ -110,9 +134,7 @@
(dom-set-style target prop "hidden") (dom-set-style target prop "hidden")
(dom-set-style target prop ""))))))) (dom-set-style target prop "")))))))
;; ── Navigation / traversal ────────────────────────────────────── ;; Find next sibling matching a selector (or any sibling).
;; Navigate to a URL.
(define (define
hs-toggle-style-between! hs-toggle-style-between!
(fn (fn
@@ -124,7 +146,7 @@
(dom-set-style target prop val2) (dom-set-style target prop val2)
(dom-set-style target prop val1))))) (dom-set-style target prop val1)))))
;; Find next sibling matching a selector (or any sibling). ;; Find previous sibling matching a selector.
(define (define
hs-toggle-style-cycle! hs-toggle-style-cycle!
(fn (fn
@@ -145,7 +167,7 @@
(true (find-next (rest remaining)))))) (true (find-next (rest remaining))))))
(dom-set-style target prop (find-next vals))))) (dom-set-style target prop (find-next vals)))))
;; Find previous sibling matching a selector. ;; First element matching selector within a scope.
(define (define
hs-take! hs-take!
(fn (fn
@@ -185,7 +207,7 @@
(dom-set-attr target name attr-val) (dom-set-attr target name attr-val)
(dom-set-attr target name "")))))))) (dom-set-attr target name ""))))))))
;; First element matching selector within a scope. ;; Last element matching selector.
(begin (begin
(define (define
hs-element? hs-element?
@@ -297,7 +319,7 @@
(dom-insert-adjacent-html target "beforeend" value) (dom-insert-adjacent-html target "beforeend" value)
(hs-boot-subtree! target))))))))) (hs-boot-subtree! target)))))))))
;; Last element matching selector. ;; First/last within a specific scope.
(define (define
hs-add-to! hs-add-to!
(fn (fn
@@ -310,7 +332,6 @@
(append target (list value)))) (append target (list value))))
(true (do (host-call target "push" value) target))))) (true (do (host-call target "push" value) target)))))
;; First/last within a specific scope.
(define (define
hs-remove-from! hs-remove-from!
(fn (fn
@@ -320,6 +341,9 @@
(filter (fn (x) (not (= x value))) target) (filter (fn (x) (not (= x value))) target)
(host-call target "splice" (host-call target "indexOf" value) 1)))) (host-call target "splice" (host-call target "indexOf" value) 1))))
;; ── Iteration ───────────────────────────────────────────────────
;; Repeat a thunk N times.
(define (define
hs-splice-at! hs-splice-at!
(fn (fn
@@ -343,9 +367,7 @@
(host-call target "splice" i 1)))) (host-call target "splice" i 1))))
target)))) target))))
;; ── Iteration ─────────────────────────────────────────────────── ;; Repeat forever (until break — relies on exception/continuation).
;; Repeat a thunk N times.
(define (define
hs-put-at! hs-put-at!
(fn (fn
@@ -364,7 +386,10 @@
((= pos "start") (host-call target "unshift" value))) ((= pos "start") (host-call target "unshift" value)))
target))))) target)))))
;; 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 (define
hs-dict-without hs-dict-without
(fn (fn
@@ -385,26 +410,27 @@
(host-call (host-global "Reflect") "deleteProperty" out key) (host-call (host-global "Reflect") "deleteProperty" out key)
out))))) out)))))
;; ── Fetch ─────────────────────────────────────────────────────── ;; ── Type coercion ───────────────────────────────────────────────
;; Fetch a URL, parse response according to format. ;; Coerce a value to a type by name.
;; (hs-fetch url format) — format is "json" | "text" | "html" ;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
(define (define
hs-set-on! hs-set-on!
(fn (fn
(props target) (props target)
(for-each (fn (k) (host-set! target k (get props k))) (keys props)))) (for-each (fn (k) (host-set! target k (get props k))) (keys props))))
;; ── Type coercion ───────────────────────────────────────────────
;; Coerce a value to a type by name.
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
;; ── Object creation ───────────────────────────────────────────── ;; ── Object creation ─────────────────────────────────────────────
;; Make a new object of a given type. ;; Make a new object of a given type.
;; (hs-make type-name) — creates empty object/collection ;; (hs-make type-name) — creates empty object/collection
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
;; ── Behavior installation ───────────────────────────────────────
;; 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 (define
hs-scroll! hs-scroll!
(fn (fn
@@ -417,11 +443,10 @@
((= position "bottom") (dict :block "end")) ((= position "bottom") (dict :block "end"))
(true (dict :block "start"))))))) (true (dict :block "start")))))))
;; ── Behavior installation ─────────────────────────────────────── ;; ── Measurement ─────────────────────────────────────────────────
;; Install a behavior on an element. ;; Measure an element's bounding rect, store as local variables.
;; A behavior is a function that takes (me ...params) and sets up features. ;; Returns a dict with x, y, width, height, top, left, right, bottom.
;; (hs-install behavior-fn me ...args)
(define (define
hs-halt! hs-halt!
(fn (fn
@@ -442,30 +467,32 @@
(host-call ev "stopPropagation"))))) (host-call ev "stopPropagation")))))
(when (not (= mode "the-event")) (raise (list "hs-return" nil)))))) (when (not (= mode "the-event")) (raise (list "hs-return" nil))))))
;; ── 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-select! (fn (target) (host-call target "select" (list))))
;; Return the current text selection as a string. In the browser this is ;; Return the current text selection as a string. In the browser this is
;; `window.getSelection().toString()`. In the mock test runner, a test ;; `window.getSelection().toString()`. In the mock test runner, a test
;; setup stashes the desired selection text at `window.__test_selection` ;; setup stashes the desired selection text at `window.__test_selection`
;; and the fallback path returns that so tests can assert on the result. ;; and the fallback path returns that so tests can assert on the result.
(define hs-get-selection (define hs-select! (fn (target) (host-call target "select" (list))))
(fn ()
(let ((win (host-global "window")))
(let ((stash (host-get win "__test_selection")))
(if (nil? stash)
(let ((sel (host-call win "getSelection" (list))))
(if (nil? sel) "" (host-call sel "toString" (list))))
stash)))))
;; ── Transition ────────────────────────────────────────────────── ;; ── Transition ──────────────────────────────────────────────────
;; Transition a CSS property to a value, optionally with duration. ;; Transition a CSS property to a value, optionally with duration.
;; (hs-transition target prop value duration) ;; (hs-transition target prop value duration)
(define
hs-get-selection
(fn
()
(let
((win (host-global "window")))
(let
((stash (host-get win "__test_selection")))
(if
(nil? stash)
(let
((sel (host-call win "getSelection" (list))))
(if (nil? sel) "" (host-call sel "toString" (list))))
stash)))))
(define (define
hs-reset! hs-reset!
(fn (fn
@@ -587,6 +614,10 @@
(define hs-first (fn (scope sel) (dom-query-all scope sel))) (define hs-first (fn (scope sel) (dom-query-all scope sel)))
(define (define
hs-last hs-last
(fn (fn
@@ -595,10 +626,6 @@
((all (dom-query-all scope sel))) ((all (dom-query-all scope sel)))
(if (> (len all) 0) (nth all (- (len all) 1)) nil)))) (if (> (len all) 0) (nth all (- (len all) 1)) nil))))
(define (define
hs-repeat-times hs-repeat-times
(fn (fn
@@ -616,7 +643,8 @@
((= signal "hs-continue") (do-repeat (+ i 1))) ((= signal "hs-continue") (do-repeat (+ i 1)))
(true (do-repeat (+ i 1)))))))) (true (do-repeat (+ i 1))))))))
(do-repeat 0))) (do-repeat 0)))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
(define (define
hs-repeat-forever hs-repeat-forever
(fn (fn
@@ -632,8 +660,7 @@
((= signal "hs-continue") (do-forever)) ((= signal "hs-continue") (do-forever))
(true (do-forever)))))) (true (do-forever))))))
(do-forever))) (do-forever)))
;; ── Sandbox/test runtime additions ────────────────────────────── ;; DOM query stub — sandbox returns empty list
;; Property access — dot notation and .length
(define (define
hs-repeat-while hs-repeat-while
(fn (fn
@@ -646,7 +673,7 @@
((= signal "hs-break") nil) ((= signal "hs-break") nil)
((= signal "hs-continue") (hs-repeat-while cond-fn thunk)) ((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
(true (hs-repeat-while cond-fn thunk))))))) (true (hs-repeat-while cond-fn thunk)))))))
;; DOM query stub — sandbox returns empty list ;; Method dispatch — obj.method(args)
(define (define
hs-repeat-until hs-repeat-until
(fn (fn
@@ -658,7 +685,9 @@
((= signal "hs-continue") ((= signal "hs-continue")
(if (cond-fn) nil (hs-repeat-until cond-fn thunk))) (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
(true (if (cond-fn) nil (hs-repeat-until cond-fn thunk))))))) (true (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))))))
;; Method dispatch — obj.method(args)
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
(define (define
hs-for-each hs-for-each
(fn (fn
@@ -678,9 +707,7 @@
((= signal "hs-continue") (do-loop (rest remaining))) ((= signal "hs-continue") (do-loop (rest remaining)))
(true (do-loop (rest remaining)))))))) (true (do-loop (rest remaining))))))))
(do-loop items)))) (do-loop items))))
;; Property-based is — check obj.key truthiness
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
(begin (begin
(define (define
hs-append hs-append
@@ -708,7 +735,7 @@
((hs-element? target) ((hs-element? target)
(dom-insert-adjacent-html target "beforeend" (str value))) (dom-insert-adjacent-html target "beforeend" (str value)))
(true nil))))) (true nil)))))
;; Property-based is — check obj.key truthiness ;; Array slicing (inclusive both ends)
(define (define
hs-sender hs-sender
(fn (fn
@@ -716,7 +743,7 @@
(let (let
((detail (host-get event "detail"))) ((detail (host-get event "detail")))
(if detail (host-get detail "sender") nil)))) (if detail (host-get detail "sender") nil))))
;; Array slicing (inclusive both ends) ;; Collection: sorted by
(define (define
hs-host-to-sx hs-host-to-sx
(fn (fn
@@ -770,7 +797,7 @@
(dict-set! out k (hs-host-to-sx (host-get v k)))) (dict-set! out k (hs-host-to-sx (host-get v k))))
(host-call (host-global "Object") "keys" v)) (host-call (host-global "Object") "keys" v))
out))))))))))) out)))))))))))
;; Collection: sorted by ;; Collection: sorted by descending
(define (define
hs-fetch hs-fetch
(fn (fn
@@ -780,7 +807,7 @@
(let (let
((raw (perform (list "io-fetch" url fmt)))) ((raw (perform (list "io-fetch" url fmt))))
(cond ((= fmt "json") (hs-host-to-sx raw)) (true raw)))))) (cond ((= fmt "json") (hs-host-to-sx raw)) (true raw))))))
;; Collection: sorted by descending ;; Collection: split by
(define (define
hs-json-escape hs-json-escape
(fn (fn
@@ -811,7 +838,7 @@
(walk) (walk)
out) out)
"\""))) "\"")))
;; Collection: split by ;; Collection: joined by
(define (define
hs-json-stringify hs-json-stringify
(fn (fn
@@ -845,7 +872,7 @@
ks))) ks)))
"}"))) "}")))
(true (hs-json-escape (str v)))))) (true (hs-json-escape (str v))))))
;; Collection: joined by
(define (define
hs-coerce hs-coerce
(fn (fn

1
shared/static/wasm/sx/hs-integration.sx
View File

@@ -80,6 +80,7 @@
((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script"))) ((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script")))
(when (when
(and src (not (= src prev))) (and src (not (= src prev)))
(hs-log-event! "hyperscript:init")
(dom-set-data el "hs-script" src) (dom-set-data el "hs-script" src)
(dom-set-data el "hs-active" true) (dom-set-data el "hs-active" true)
(dom-set-attr el "data-hyperscript-powered" "true") (dom-set-attr el "data-hyperscript-powered" "true")

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

@@ -12,14 +12,37 @@
;; Register an event listener. Returns unlisten function. ;; Register an event listener. Returns unlisten function.
;; (hs-on target event-name handler) → unlisten-fn ;; (hs-on target event-name handler) → unlisten-fn
(begin
(define _hs-config-log-all false)
(define _hs-log-captured (list))
(define
hs-set-log-all!
(fn (flag) (set! _hs-config-log-all (if flag true false))))
(define hs-get-log-captured (fn () _hs-log-captured))
(define
hs-clear-log-captured!
(fn () (begin (set! _hs-log-captured (list)) nil)))
(define
hs-log-event!
(fn
(msg)
(when
_hs-config-log-all
(begin
(set! _hs-log-captured (append _hs-log-captured (list msg)))
(host-call (host-global "console") "log" msg)
nil)))))
;; Register for every occurrence (no queuing — each fires independently).
;; Stock hyperscript queues by default; "every" disables queuing.
(define (define
hs-each hs-each
(fn (fn
(target action) (target action)
(if (list? target) (for-each action target) (action target)))) (if (list? target) (for-each action target) (action target))))
;; Register for every occurrence (no queuing — each fires independently). ;; Run an initializer function immediately.
;; Stock hyperscript queues by default; "every" disables queuing. ;; (hs-init thunk) — called at element boot time
(define (define
hs-on hs-on
(fn (fn
@@ -32,24 +55,25 @@
(dom-set-data target "hs-unlisteners" (append prev (list unlisten))) (dom-set-data target "hs-unlisteners" (append prev (list unlisten)))
unlisten)))) unlisten))))
;; Run an initializer function immediately.
;; (hs-init thunk) — called at element boot time
(define
hs-on-every
(fn (target event-name handler) (dom-listen target event-name handler)))
;; ── Async / timing ────────────────────────────────────────────── ;; ── Async / timing ──────────────────────────────────────────────
;; Wait for a duration in milliseconds. ;; Wait for a duration in milliseconds.
;; In hyperscript, wait is async-transparent — execution pauses. ;; In hyperscript, wait is async-transparent — execution pauses.
;; Here we use perform/IO suspension for true pause semantics. ;; Here we use perform/IO suspension for true pause semantics.
(define hs-init (fn (thunk) (thunk))) (define
hs-on-every
(fn (target event-name handler) (dom-listen target event-name handler)))
;; Wait for a DOM event on a target. ;; Wait for a DOM event on a target.
;; (hs-wait-for target event-name) — suspends until event fires ;; (hs-wait-for target event-name) — suspends until event fires
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms)))) (define hs-init (fn (thunk) (thunk)))
;; Wait for CSS transitions/animations to settle on an element. ;; Wait for CSS transitions/animations to settle on an element.
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
;; ── Class manipulation ──────────────────────────────────────────
;; Toggle a single class on an element.
(begin (begin
(define (define
hs-wait-for hs-wait-for
@@ -62,18 +86,19 @@
(target event-name timeout-ms) (target event-name timeout-ms)
(perform (list (quote io-wait-event) target event-name timeout-ms))))) (perform (list (quote io-wait-event) target event-name timeout-ms)))))
;; ── Class manipulation ────────────────────────────────────────── ;; Toggle between two classes — exactly one is active at a time.
;; Toggle a single class on an element.
(define hs-settle (fn (target) (perform (list (quote io-settle) target)))) (define hs-settle (fn (target) (perform (list (quote io-settle) target))))
;; Toggle between two classes — exactly one is active at a time. ;; Take a class from siblings — add to target, remove from others.
;; (hs-take! target cls) — like radio button class behavior
(define (define
hs-toggle-class! hs-toggle-class!
(fn (target cls) (host-call (host-get target "classList") "toggle" cls))) (fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
;; Take a class from siblings — add to target, remove from others. ;; ── DOM insertion ───────────────────────────────────────────────
;; (hs-take! target cls) — like radio button class behavior
;; Put content at a position relative to a target.
;; pos: "into" | "before" | "after"
(define (define
hs-toggle-between! hs-toggle-between!
(fn (fn
@@ -83,10 +108,9 @@
(do (dom-remove-class target cls1) (dom-add-class target cls2)) (do (dom-remove-class target cls1) (dom-add-class target cls2))
(do (dom-remove-class target cls2) (dom-add-class target cls1))))) (do (dom-remove-class target cls2) (dom-add-class target cls1)))))
;; ── DOM insertion ─────────────────────────────────────────────── ;; ── Navigation / traversal ──────────────────────────────────────
;; Put content at a position relative to a target. ;; Navigate to a URL.
;; pos: "into" | "before" | "after"
(define (define
hs-toggle-style! hs-toggle-style!
(fn (fn
@@ -110,9 +134,7 @@
(dom-set-style target prop "hidden") (dom-set-style target prop "hidden")
(dom-set-style target prop ""))))))) (dom-set-style target prop "")))))))
;; ── Navigation / traversal ────────────────────────────────────── ;; Find next sibling matching a selector (or any sibling).
;; Navigate to a URL.
(define (define
hs-toggle-style-between! hs-toggle-style-between!
(fn (fn
@@ -124,7 +146,7 @@
(dom-set-style target prop val2) (dom-set-style target prop val2)
(dom-set-style target prop val1))))) (dom-set-style target prop val1)))))
;; Find next sibling matching a selector (or any sibling). ;; Find previous sibling matching a selector.
(define (define
hs-toggle-style-cycle! hs-toggle-style-cycle!
(fn (fn
@@ -145,7 +167,7 @@
(true (find-next (rest remaining)))))) (true (find-next (rest remaining))))))
(dom-set-style target prop (find-next vals))))) (dom-set-style target prop (find-next vals)))))
;; Find previous sibling matching a selector. ;; First element matching selector within a scope.
(define (define
hs-take! hs-take!
(fn (fn
@@ -185,7 +207,7 @@
(dom-set-attr target name attr-val) (dom-set-attr target name attr-val)
(dom-set-attr target name "")))))))) (dom-set-attr target name ""))))))))
;; First element matching selector within a scope. ;; Last element matching selector.
(begin (begin
(define (define
hs-element? hs-element?
@@ -297,7 +319,7 @@
(dom-insert-adjacent-html target "beforeend" value) (dom-insert-adjacent-html target "beforeend" value)
(hs-boot-subtree! target))))))))) (hs-boot-subtree! target)))))))))
;; Last element matching selector. ;; First/last within a specific scope.
(define (define
hs-add-to! hs-add-to!
(fn (fn
@@ -310,7 +332,6 @@
(append target (list value)))) (append target (list value))))
(true (do (host-call target "push" value) target))))) (true (do (host-call target "push" value) target)))))
;; First/last within a specific scope.
(define (define
hs-remove-from! hs-remove-from!
(fn (fn
@@ -320,6 +341,9 @@
(filter (fn (x) (not (= x value))) target) (filter (fn (x) (not (= x value))) target)
(host-call target "splice" (host-call target "indexOf" value) 1)))) (host-call target "splice" (host-call target "indexOf" value) 1))))
;; ── Iteration ───────────────────────────────────────────────────
;; Repeat a thunk N times.
(define (define
hs-splice-at! hs-splice-at!
(fn (fn
@@ -343,9 +367,7 @@
(host-call target "splice" i 1)))) (host-call target "splice" i 1))))
target)))) target))))
;; ── Iteration ─────────────────────────────────────────────────── ;; Repeat forever (until break — relies on exception/continuation).
;; Repeat a thunk N times.
(define (define
hs-put-at! hs-put-at!
(fn (fn
@@ -364,7 +386,10 @@
((= pos "start") (host-call target "unshift" value))) ((= pos "start") (host-call target "unshift" value)))
target))))) target)))))
;; 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 (define
hs-dict-without hs-dict-without
(fn (fn
@@ -385,26 +410,27 @@
(host-call (host-global "Reflect") "deleteProperty" out key) (host-call (host-global "Reflect") "deleteProperty" out key)
out))))) out)))))
;; ── Fetch ─────────────────────────────────────────────────────── ;; ── Type coercion ───────────────────────────────────────────────
;; Fetch a URL, parse response according to format. ;; Coerce a value to a type by name.
;; (hs-fetch url format) — format is "json" | "text" | "html" ;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
(define (define
hs-set-on! hs-set-on!
(fn (fn
(props target) (props target)
(for-each (fn (k) (host-set! target k (get props k))) (keys props)))) (for-each (fn (k) (host-set! target k (get props k))) (keys props))))
;; ── Type coercion ───────────────────────────────────────────────
;; Coerce a value to a type by name.
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
;; ── Object creation ───────────────────────────────────────────── ;; ── Object creation ─────────────────────────────────────────────
;; Make a new object of a given type. ;; Make a new object of a given type.
;; (hs-make type-name) — creates empty object/collection ;; (hs-make type-name) — creates empty object/collection
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
;; ── Behavior installation ───────────────────────────────────────
;; 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 (define
hs-scroll! hs-scroll!
(fn (fn
@@ -417,11 +443,10 @@
((= position "bottom") (dict :block "end")) ((= position "bottom") (dict :block "end"))
(true (dict :block "start"))))))) (true (dict :block "start")))))))
;; ── Behavior installation ─────────────────────────────────────── ;; ── Measurement ─────────────────────────────────────────────────
;; Install a behavior on an element. ;; Measure an element's bounding rect, store as local variables.
;; A behavior is a function that takes (me ...params) and sets up features. ;; Returns a dict with x, y, width, height, top, left, right, bottom.
;; (hs-install behavior-fn me ...args)
(define (define
hs-halt! hs-halt!
(fn (fn
@@ -442,30 +467,32 @@
(host-call ev "stopPropagation"))))) (host-call ev "stopPropagation")))))
(when (not (= mode "the-event")) (raise (list "hs-return" nil)))))) (when (not (= mode "the-event")) (raise (list "hs-return" nil))))))
;; ── 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-select! (fn (target) (host-call target "select" (list))))
;; Return the current text selection as a string. In the browser this is ;; Return the current text selection as a string. In the browser this is
;; `window.getSelection().toString()`. In the mock test runner, a test ;; `window.getSelection().toString()`. In the mock test runner, a test
;; setup stashes the desired selection text at `window.__test_selection` ;; setup stashes the desired selection text at `window.__test_selection`
;; and the fallback path returns that so tests can assert on the result. ;; and the fallback path returns that so tests can assert on the result.
(define hs-get-selection (define hs-select! (fn (target) (host-call target "select" (list))))
(fn ()
(let ((win (host-global "window")))
(let ((stash (host-get win "__test_selection")))
(if (nil? stash)
(let ((sel (host-call win "getSelection" (list))))
(if (nil? sel) "" (host-call sel "toString" (list))))
stash)))))
;; ── Transition ────────────────────────────────────────────────── ;; ── Transition ──────────────────────────────────────────────────
;; Transition a CSS property to a value, optionally with duration. ;; Transition a CSS property to a value, optionally with duration.
;; (hs-transition target prop value duration) ;; (hs-transition target prop value duration)
(define
hs-get-selection
(fn
()
(let
((win (host-global "window")))
(let
((stash (host-get win "__test_selection")))
(if
(nil? stash)
(let
((sel (host-call win "getSelection" (list))))
(if (nil? sel) "" (host-call sel "toString" (list))))
stash)))))
(define (define
hs-reset! hs-reset!
(fn (fn
@@ -587,6 +614,10 @@
(define hs-first (fn (scope sel) (dom-query-all scope sel))) (define hs-first (fn (scope sel) (dom-query-all scope sel)))
(define (define
hs-last hs-last
(fn (fn
@@ -595,10 +626,6 @@
((all (dom-query-all scope sel))) ((all (dom-query-all scope sel)))
(if (> (len all) 0) (nth all (- (len all) 1)) nil)))) (if (> (len all) 0) (nth all (- (len all) 1)) nil))))
(define (define
hs-repeat-times hs-repeat-times
(fn (fn
@@ -616,7 +643,8 @@
((= signal "hs-continue") (do-repeat (+ i 1))) ((= signal "hs-continue") (do-repeat (+ i 1)))
(true (do-repeat (+ i 1)))))))) (true (do-repeat (+ i 1))))))))
(do-repeat 0))) (do-repeat 0)))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
(define (define
hs-repeat-forever hs-repeat-forever
(fn (fn
@@ -632,8 +660,7 @@
((= signal "hs-continue") (do-forever)) ((= signal "hs-continue") (do-forever))
(true (do-forever)))))) (true (do-forever))))))
(do-forever))) (do-forever)))
;; ── Sandbox/test runtime additions ────────────────────────────── ;; DOM query stub — sandbox returns empty list
;; Property access — dot notation and .length
(define (define
hs-repeat-while hs-repeat-while
(fn (fn
@@ -646,7 +673,7 @@
((= signal "hs-break") nil) ((= signal "hs-break") nil)
((= signal "hs-continue") (hs-repeat-while cond-fn thunk)) ((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
(true (hs-repeat-while cond-fn thunk))))))) (true (hs-repeat-while cond-fn thunk)))))))
;; DOM query stub — sandbox returns empty list ;; Method dispatch — obj.method(args)
(define (define
hs-repeat-until hs-repeat-until
(fn (fn
@@ -658,7 +685,9 @@
((= signal "hs-continue") ((= signal "hs-continue")
(if (cond-fn) nil (hs-repeat-until cond-fn thunk))) (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
(true (if (cond-fn) nil (hs-repeat-until cond-fn thunk))))))) (true (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))))))
;; Method dispatch — obj.method(args)
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
(define (define
hs-for-each hs-for-each
(fn (fn
@@ -678,9 +707,7 @@
((= signal "hs-continue") (do-loop (rest remaining))) ((= signal "hs-continue") (do-loop (rest remaining)))
(true (do-loop (rest remaining)))))))) (true (do-loop (rest remaining))))))))
(do-loop items)))) (do-loop items))))
;; Property-based is — check obj.key truthiness
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
(begin (begin
(define (define
hs-append hs-append
@@ -708,7 +735,7 @@
((hs-element? target) ((hs-element? target)
(dom-insert-adjacent-html target "beforeend" (str value))) (dom-insert-adjacent-html target "beforeend" (str value)))
(true nil))))) (true nil)))))
;; Property-based is — check obj.key truthiness ;; Array slicing (inclusive both ends)
(define (define
hs-sender hs-sender
(fn (fn
@@ -716,7 +743,7 @@
(let (let
((detail (host-get event "detail"))) ((detail (host-get event "detail")))
(if detail (host-get detail "sender") nil)))) (if detail (host-get detail "sender") nil))))
;; Array slicing (inclusive both ends) ;; Collection: sorted by
(define (define
hs-host-to-sx hs-host-to-sx
(fn (fn
@@ -770,7 +797,7 @@
(dict-set! out k (hs-host-to-sx (host-get v k)))) (dict-set! out k (hs-host-to-sx (host-get v k))))
(host-call (host-global "Object") "keys" v)) (host-call (host-global "Object") "keys" v))
out))))))))))) out)))))))))))
;; Collection: sorted by ;; Collection: sorted by descending
(define (define
hs-fetch hs-fetch
(fn (fn
@@ -780,7 +807,7 @@
(let (let
((raw (perform (list "io-fetch" url fmt)))) ((raw (perform (list "io-fetch" url fmt))))
(cond ((= fmt "json") (hs-host-to-sx raw)) (true raw)))))) (cond ((= fmt "json") (hs-host-to-sx raw)) (true raw))))))
;; Collection: sorted by descending ;; Collection: split by
(define (define
hs-json-escape hs-json-escape
(fn (fn
@@ -811,7 +838,7 @@
(walk) (walk)
out) out)
"\""))) "\"")))
;; Collection: split by ;; Collection: joined by
(define (define
hs-json-stringify hs-json-stringify
(fn (fn
@@ -845,7 +872,7 @@
ks))) ks)))
"}"))) "}")))
(true (hs-json-escape (str v)))))) (true (hs-json-escape (str v))))))
;; Collection: joined by
(define (define
hs-coerce hs-coerce
(fn (fn

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

@@ -1413,7 +1413,17 @@
(deftest "hyperscript:before:init can cancel initialization" (deftest "hyperscript:before:init can cancel initialization"
(error "SKIP (untranslated): hyperscript:before:init can cancel initialization")) (error "SKIP (untranslated): hyperscript:before:init can cancel initialization"))
(deftest "logAll config logs events to console" (deftest "logAll config logs events to console"
(error "SKIP (untranslated): logAll config logs events to console")) (hs-cleanup!)
(hs-clear-log-captured!)
(hs-set-log-all! true)
(let ((wa (dom-create-element "div")))
(dom-set-inner-html wa "<div _=\"on click add .foo\"></div>")
(hs-boot-subtree! wa))
(hs-set-log-all! false)
(assert= (some (fn (l) (string-contains? l "hyperscript:"))
(hs-get-log-captured))
true)
)
(deftest "on a single div" (deftest "on a single div"
(hs-cleanup!) (hs-cleanup!)
(let ((_el-div (dom-create-element "div"))) (let ((_el-div (dom-create-element "div")))

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

@@ -1771,6 +1771,27 @@ def generate_eval_only_test(test, idx):
body = test.get('body', '') body = test.get('body', '')
lines = [] lines = []
safe_name = sx_name(test['name']) safe_name = sx_name(test['name'])
# Special case: logAll config test. Body sets `_hyperscript.config.logAll = true`,
# then mutates an element's innerHTML and calls `_hyperscript.processNode`.
# Our runtime exposes this via hs-set-log-all! + hs-log-captured; we reuse
# the same mechanics without re-parsing the body.
if 'logAll' in body and '_hyperscript.config.logAll' in body:
return (
f' (deftest "{safe_name}"\n'
f' (hs-cleanup!)\n'
f' (hs-clear-log-captured!)\n'
f' (hs-set-log-all! true)\n'
f' (let ((wa (dom-create-element "div")))\n'
f' (dom-set-inner-html wa "<div _=\\"on click add .foo\\"></div>")\n'
f' (hs-boot-subtree! wa))\n'
f' (hs-set-log-all! false)\n'
f' (assert= (some (fn (l) (string-contains? l "hyperscript:"))\n'
f' (hs-get-log-captured))\n'
f' true)\n'
f' )'
)
lines.append(f' (deftest "{safe_name}"') lines.append(f' (deftest "{safe_name}"')
assertions = [] assertions = []