HS: cookies iteration via host-iter? before dict? (+1 test)

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
2026-04-26 14:24:16 +00:00
parent 11ee71d846
commit 4b69650336
5 changed files with 128 additions and 93 deletions

View File

@@ -780,7 +780,7 @@
(fn
(fn-body collection)
(let
((items (cond ((list? collection) collection) ((dict? collection) (if (dict-has? collection "_order") (get collection "_order") (filter (fn (k) (not (= k "_order"))) (keys collection)))) ((nil? collection) (list)) (true (list)))))
((items (cond ((list? collection) collection) ((nil? collection) (list)) ((host-iter? collection) (host-to-list collection)) ((dict? collection) (if (dict-has? collection "_order") (get collection "_order") (filter (fn (k) (not (= k "_order"))) (keys collection)))) (true (list)))))
(define
do-loop
(fn

View File

@@ -45,6 +45,11 @@
;; (hs-init thunk) — called at element boot time
(define meta (host-new "Object"))
;; ── Async / timing ──────────────────────────────────────────────
;; Wait for a duration in milliseconds.
;; In hyperscript, wait is async-transparent — execution pauses.
;; Here we use perform/IO suspension for true pause semantics.
(define
_hs-on-caller
(let
@@ -57,6 +62,8 @@
(host-set! _ctx "meta" _m)
_ctx)))
;; Wait for a DOM event on a target.
;; (hs-wait-for target event-name) — suspends until event fires
(define
hs-on
(fn
@@ -69,17 +76,14 @@
(dom-set-data target "hs-unlisteners" (append prev (list unlisten)))
unlisten))))
;; ── Async / timing ──────────────────────────────────────────────
;; Wait for a duration in milliseconds.
;; In hyperscript, wait is async-transparent — execution pauses.
;; Here we use perform/IO suspension for true pause semantics.
;; Wait for CSS transitions/animations to settle on an element.
(define
hs-on-every
(fn (target event-name handler) (dom-listen target event-name handler)))
;; Wait for a DOM event on a target.
;; (hs-wait-for target event-name) — suspends until event fires
;; ── Class manipulation ──────────────────────────────────────────
;; Toggle a single class on an element.
(define
hs-on-intersection-attach!
(fn
@@ -95,7 +99,7 @@
(host-call observer "observe" target)
observer)))))
;; Wait for CSS transitions/animations to settle on an element.
;; Toggle between two classes — exactly one is active at a time.
(define
hs-on-mutation-attach!
(fn
@@ -116,16 +120,19 @@
(host-call observer "observe" target opts)
observer))))))
;; ── Class manipulation ──────────────────────────────────────────
;; Toggle a single class on an element.
(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
(define hs-init (fn (thunk) (thunk)))
;; ── DOM insertion ───────────────────────────────────────────────
;; Put content at a position relative to a target.
;; pos: "into" | "before" | "after"
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
;; ── Navigation / traversal ──────────────────────────────────────
;; Navigate to a URL.
(begin
(define
hs-wait-for
@@ -138,20 +145,15 @@
(target event-name timeout-ms)
(perform (list (quote io-wait-event) target event-name timeout-ms)))))
;; ── DOM insertion ───────────────────────────────────────────────
;; Put content at a position relative to a target.
;; pos: "into" | "before" | "after"
;; Find next sibling matching a selector (or any sibling).
(define hs-settle (fn (target) (perform (list (quote io-settle) target))))
;; ── Navigation / traversal ──────────────────────────────────────
;; Navigate to a URL.
;; Find previous sibling matching a selector.
(define
hs-toggle-class!
(fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
;; Find next sibling matching a selector (or any sibling).
;; First element matching selector within a scope.
(define
hs-toggle-between!
(fn
@@ -161,7 +163,7 @@
(do (dom-remove-class target cls1) (dom-add-class target cls2))
(do (dom-remove-class target cls2) (dom-add-class target cls1)))))
;; Find previous sibling matching a selector.
;; Last element matching selector.
(define
hs-toggle-style!
(fn
@@ -185,7 +187,7 @@
(dom-set-style target prop "hidden")
(dom-set-style target prop "")))))))
;; First element matching selector within a scope.
;; First/last within a specific scope.
(define
hs-toggle-style-between!
(fn
@@ -197,7 +199,6 @@
(dom-set-style target prop val2)
(dom-set-style target prop val1)))))
;; Last element matching selector.
(define
hs-toggle-style-cycle!
(fn
@@ -218,7 +219,9 @@
(true (find-next (rest remaining))))))
(dom-set-style target prop (find-next vals)))))
;; First/last within a specific scope.
;; ── Iteration ───────────────────────────────────────────────────
;; Repeat a thunk N times.
(define
hs-take!
(fn
@@ -258,6 +261,7 @@
(dom-set-attr target name attr-val)
(dom-set-attr target name ""))))))))
;; Repeat forever (until break — relies on exception/continuation).
(begin
(define
hs-element?
@@ -369,9 +373,10 @@
(dom-insert-adjacent-html target "beforeend" value)
(hs-boot-subtree! target)))))))))
;; ── Iteration ───────────────────────────────────────────────────
;; ── Fetch ───────────────────────────────────────────────────────
;; Repeat a thunk N times.
;; Fetch a URL, parse response according to format.
;; (hs-fetch url format) — format is "json" | "text" | "html"
(define
hs-add-to!
(fn
@@ -384,7 +389,10 @@
(append target (list value))))
(true (do (host-call target "push" value) target)))))
;; Repeat forever (until break — relies on exception/continuation).
;; ── Type coercion ───────────────────────────────────────────────
;; Coerce a value to a type by name.
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
(define
hs-remove-from!
(fn
@@ -394,10 +402,10 @@
(filter (fn (x) (not (= x value))) target)
(host-call target "splice" (host-call target "indexOf" value) 1))))
;; ── Fetch ───────────────────────────────────────────────────────
;; ── Object creation ─────────────────────────────────────────────
;; Fetch a URL, parse response according to format.
;; (hs-fetch url format) — format is "json" | "text" | "html"
;; Make a new object of a given type.
;; (hs-make type-name) — creates empty object/collection
(define
hs-splice-at!
(fn
@@ -421,10 +429,11 @@
(host-call target "splice" i 1))))
target))))
;; ── Type coercion ───────────────────────────────────────────────
;; ── Behavior installation ───────────────────────────────────────
;; Coerce a value to a type by name.
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
;; 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-index
(fn
@@ -436,10 +445,10 @@
((string? obj) (nth obj key))
(true (host-get obj key)))))
;; ── Object creation ─────────────────────────────────────────────
;; ── Measurement ─────────────────────────────────────────────────
;; Make a new object of a given type.
;; (hs-make type-name) — creates empty object/collection
;; Measure an element's bounding rect, store as local variables.
;; Returns a dict with x, y, width, height, top, left, right, bottom.
(define
hs-put-at!
(fn
@@ -461,11 +470,10 @@
((= pos "start") (host-call target "unshift" value)))
target)))))))
;; ── 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)
;; 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-dict-without
(fn
@@ -486,27 +494,19 @@
(host-call (host-global "Reflect") "deleteProperty" out key)
out)))))
;; ── Measurement ─────────────────────────────────────────────────
;; Measure an element's bounding rect, store as local variables.
;; Returns a dict with x, y, width, height, top, left, right, bottom.
;; ── Transition ──────────────────────────────────────────────────
;; Transition a CSS property to a value, optionally with duration.
;; (hs-transition target prop value duration)
(define
hs-set-on!
(fn
(props target)
(for-each (fn (k) (host-set! target k (get props k))) (keys props))))
;; 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
@@ -645,6 +645,10 @@
(true (find-next (dom-next-sibling el))))))
(find-next sibling)))))
(define
hs-previous
(fn
@@ -667,11 +671,8 @@
(define
hs-query-all
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
(define
hs-query-all-in
(fn
@@ -680,22 +681,23 @@
(nil? target)
(hs-query-all sel)
(host-call target "querySelectorAll" sel))))
;; DOM query stub — sandbox returns empty list
(define
hs-list-set
(fn
(lst idx val)
(append (take lst idx) (cons val (drop lst (+ idx 1))))))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
;; Method dispatch — obj.method(args)
(define
hs-to-number
(fn (v) (if (number? v) v (or (parse-number (str v)) 0))))
;; DOM query stub — sandbox returns empty list
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
(define
hs-query-first
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
;; Method dispatch — obj.method(args)
;; Property-based is — check obj.key truthiness
(define
hs-query-last
(fn
@@ -703,11 +705,9 @@
(let
((all (dom-query-all (dom-body) sel)))
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
;; Array slicing (inclusive both ends)
(define hs-first (fn (scope sel) (dom-query-all scope sel)))
;; Property-based is — check obj.key truthiness
;; Collection: sorted by
(define
hs-last
(fn
@@ -715,7 +715,7 @@
(let
((all (dom-query-all scope sel)))
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
;; Array slicing (inclusive both ends)
;; Collection: sorted by descending
(define
hs-repeat-times
(fn
@@ -733,7 +733,7 @@
((= signal "hs-continue") (do-repeat (+ i 1)))
(true (do-repeat (+ i 1))))))))
(do-repeat 0)))
;; Collection: sorted by
;; Collection: split by
(define
hs-repeat-forever
(fn
@@ -749,7 +749,7 @@
((= signal "hs-continue") (do-forever))
(true (do-forever))))))
(do-forever)))
;; Collection: sorted by descending
;; Collection: joined by
(define
hs-repeat-while
(fn
@@ -762,7 +762,7 @@
((= signal "hs-break") nil)
((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
(true (hs-repeat-while cond-fn thunk)))))))
;; Collection: split by
(define
hs-repeat-until
(fn
@@ -774,13 +774,13 @@
((= 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: joined by
(define
hs-for-each
(fn
(fn-body collection)
(let
((items (cond ((list? collection) collection) ((dict? collection) (if (dict-has? collection "_order") (get collection "_order") (filter (fn (k) (not (= k "_order"))) (keys collection)))) ((nil? collection) (list)) (true (list)))))
((items (cond ((list? collection) collection) ((nil? collection) (list)) ((host-iter? collection) (host-to-list collection)) ((dict? collection) (if (dict-has? collection "_order") (get collection "_order") (filter (fn (k) (not (= k "_order"))) (keys collection)))) (true (list)))))
(define
do-loop
(fn
@@ -2525,6 +2525,8 @@
((nth entry 2) val)))
_hs-dom-watchers)))
;; ── SourceInfo API ────────────────────────────────────────────────
(define
hs-dom-is-ancestor?
(fn
@@ -2540,8 +2542,6 @@
(fn-name args)
(let ((fn (host-global fn-name))) (if fn (host-call-fn fn args) nil))))
;; ── SourceInfo API ────────────────────────────────────────────────
(define
hs-source-for
(fn
@@ -2557,16 +2557,9 @@
(line-idx (- (get node :line) 1)))
(if (< line-idx (len lines)) (nth lines line-idx) ""))))
(define
hs-node-get
(fn
(node key)
(get (get node :fields) key)))
(define hs-node-get (fn (node key) (get (get node :fields) key)))
(define
hs-src
(fn (src-str)
(hs-source-for (hs-parse-ast src-str))))
(define hs-src (fn (src-str) (hs-source-for (hs-parse-ast src-str))))
(define
hs-src-at
@@ -2576,7 +2569,8 @@
walk
(fn
(node keys)
(if (or (nil? keys) (= (len keys) 0))
(if
(or (nil? keys) (= (len keys) 0))
node
(walk (hs-node-get node (first keys)) (rest keys)))))
(hs-source-for (walk (hs-parse-ast src-str) path))))
@@ -2589,7 +2583,8 @@
walk
(fn
(node keys)
(if (or (nil? keys) (= (len keys) 0))
(if
(or (nil? keys) (= (len keys) 0))
node
(walk (hs-node-get node (first keys)) (rest keys)))))
(hs-line-for (walk (hs-parse-ast src-str) path))))

View File

@@ -4974,7 +4974,17 @@
(eval-hs "set cookies.foo to 'bar'")
(assert= (eval-hs "cookies.foo") "bar"))
(deftest "iterate cookies values work"
(error "SKIP (untranslated): iterate cookies values work"))
(hs-cleanup!)
(host-set! (host-global "cookies") "foo" "bar")
(let ((_names (list)) (_values (list)))
(hs-for-each
(fn (x)
(append! _names (host-get x "name"))
(append! _values (host-get x "value")))
(host-global "cookies"))
(assert-contains "foo" _names)
(assert-contains "bar" _values))
)
(deftest "length is 0 when no cookies are set"
(hs-cleanup!)
(assert= (eval-hs "cookies.length") 0))

View File

@@ -346,7 +346,8 @@ globalThis.cookies = new Proxy({}, {
get(_, k){
if(k==='length') return globalThis.__hsCookieStore.size;
if(k==='clear') return (name)=>globalThis.__hsCookieStore.delete(String(name));
if(typeof k==='symbol' || k==='_type' || k==='_order') return undefined;
if(k===Symbol.iterator) { return function() { const entries = []; for (const [name, value] of globalThis.__hsCookieStore) entries.push({_type:'dict', name, value}); return entries[Symbol.iterator](); }; }
if(typeof k==='symbol' || k==='_order') return undefined;
return globalThis.__hsCookieStore.has(k) ? globalThis.__hsCookieStore.get(k) : null;
},
set(_, k, v){ globalThis.__hsCookieStore.set(String(k), String(v)); return true; },
@@ -356,6 +357,11 @@ globalThis.cookies = new Proxy({}, {
if(globalThis.__hsCookieStore.has(k)) return {value: globalThis.__hsCookieStore.get(k), enumerable: true, configurable: true};
return undefined;
},
[Symbol.iterator]() {
const entries = [];
for (const [name, value] of globalThis.__hsCookieStore) entries.push({_type:'dict', name, value});
return entries[Symbol.iterator]();
},
});
// cluster-28: test-name-keyed confirm/prompt/alert mocks. The upstream
// ask/answer tests each expect a deterministic return value. Keyed on
@@ -557,6 +563,8 @@ K.registerNative('host-call-fn',a=>{const[fn,argList]=a;if(typeof fn!=='function
K.registerNative('host-new',a=>{const C=typeof a[0]==='string'?globalThis[a[0]]:a[0];return typeof C==='function'?new C(...a.slice(1)):null;});
K.registerNative('host-callback',a=>{const fn=a[0];if(typeof fn==='function'&&fn.__sx_handle===undefined)return fn;if(fn&&fn.__sx_handle!==undefined)return function(){const r=K.callFn(fn,Array.from(arguments));if(globalThis._driveAsync)globalThis._driveAsync(r);return r;};return function(){};});
K.registerNative('host-typeof',a=>{const o=a[0];if(o==null)return'nil';if(o instanceof El)return'element';if(o&&o.nodeType===3)return'text';if(o instanceof Ev)return'event';if(o instanceof Promise)return'promise';return typeof o;});
K.registerNative('host-iter?',([obj])=>obj!=null&&typeof obj[Symbol.iterator]==='function');
K.registerNative('host-to-list',([obj])=>{try{return[...obj];}catch(e){return[];}});
K.registerNative('host-await',a=>{});
K.registerNative('load-library!',()=>false);

View File

@@ -140,6 +140,23 @@ SKIP_TEST_NAMES = {
"Response can be converted to JSON via as JSON",
}
# Manually-written SX test bodies for tests whose upstream body cannot be
# auto-translated. Key = test name; value = SX lines to emit inside deftest.
MANUAL_TEST_BODIES = {
"iterate cookies values work": [
' (hs-cleanup!)',
' (host-set! (host-global "cookies") "foo" "bar")',
' (let ((_names (list)) (_values (list)))',
' (hs-for-each',
' (fn (x)',
' (append! _names (host-get x "name"))',
' (append! _values (host-get x "value")))',
' (host-global "cookies"))',
' (assert-contains "foo" _names)',
' (assert-contains "bar" _values))',
],
}
def find_me_receiver(elements, var_names, tag):
"""For tests with multiple top-level elements of the same tag, find the
@@ -2599,6 +2616,11 @@ def generate_compile_only_test(test):
def generate_test(test, idx):
"""Generate SX deftest for an upstream test. Dispatches to Chai, PW, or eval-only."""
if test['name'] in MANUAL_TEST_BODIES:
name = sx_name(test['name'])
lines = [f' (deftest "{name}"'] + MANUAL_TEST_BODIES[test['name']] + [' )']
return '\n'.join(lines)
elements = parse_html(test['html'])
if not elements and not test.get('html', '').strip():