HS: fix empty/halt/morph/reset/dialog — 17 upstream tests pass
- parser `empty` no-target → (ref "me") (was bogus (sym "me")) - parser `halt` modes distinguish: "all"/"bubbling"/"default" halt execution (raise hs-return), "the-event"/"the event's" only stop propagation/default. "'s" now matched as op token, not keyword. - parser `get` cmd: dispatch + cmd-kw list + parse-get-cmd (parses expr with optional `as TYPE`). Required for `get result as JSON` in fetch chains. - compiler empty-target for (local X): emit (set! X (hs-empty-like X)) so arrays/sets/maps clear the variable, not call DOM empty on the value. - runtime hs-empty-like: container-of-same-type empty value. - runtime hs-empty-target!: drop dead FORM branch that was short-circuiting to innerHTML=""; the querySelectorAll-over-inputs branch now runs. - runtime hs-halt!: take ev param (was free `event` lookup); raise hs-return to stop execution unless mode is "the-event". - runtime hs-reset!: type-aware — FORM → reset, INPUT/TEXTAREA → value/checked from defaults, SELECT → defaultSelected option. - runtime hs-open!/hs-close!: toggle `open` attribute on details elements (not just the prop) so dom-has-attr? assertions work. - runtime hs-coerce JSON: json-stringify dict/list (was str). - test-runner mock: host-get on List + "length"/"size" (was only Dict); dom-set-attr tracks defaultChecked / defaultSelected / defaultValue; mock_query_all supports comma-separated selector groups. - generator: emit boolean attrs (checked/selected/etc) even with null value; drop overcautious "skip HS with bare quotes or embedded HTML" guard so morph tests (source contains embedded <div>) emit properly. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -156,26 +156,77 @@
|
||||
(dom-set-attr target name ""))))))))
|
||||
|
||||
;; First element matching selector within a scope.
|
||||
(define
|
||||
hs-put!
|
||||
(fn
|
||||
(value pos target)
|
||||
(cond
|
||||
((= pos "into")
|
||||
(if (list? target) target (dom-set-inner-html target value)))
|
||||
((= pos "before")
|
||||
(dom-insert-adjacent-html target "beforebegin" value))
|
||||
((= pos "after") (dom-insert-adjacent-html target "afterend" value))
|
||||
((= pos "start")
|
||||
(if
|
||||
(list? target)
|
||||
(append! target value 0)
|
||||
(dom-insert-adjacent-html target "afterbegin" value)))
|
||||
((= pos "end")
|
||||
(if
|
||||
(list? target)
|
||||
(append! target value)
|
||||
(dom-insert-adjacent-html target "beforeend" value))))))
|
||||
(begin
|
||||
(define
|
||||
hs-element?
|
||||
(fn
|
||||
(v)
|
||||
(and v (or (host-get v "nodeType") (host-get v "__mock_type")))))
|
||||
(define
|
||||
hs-set-attr!
|
||||
(fn
|
||||
(el name val)
|
||||
(if (nil? val) (dom-remove-attr el name) (dom-set-attr el name val))))
|
||||
(define
|
||||
hs-put!
|
||||
(fn
|
||||
(value pos target)
|
||||
(cond
|
||||
((= pos "into")
|
||||
(cond
|
||||
((list? target) target)
|
||||
((hs-element? value)
|
||||
(do
|
||||
(dom-set-inner-html target "")
|
||||
(host-call target "appendChild" value)))
|
||||
(true
|
||||
(do
|
||||
(dom-set-inner-html target value)
|
||||
(hs-boot-subtree! target)))))
|
||||
((= pos "before")
|
||||
(if
|
||||
(hs-element? value)
|
||||
(let
|
||||
((parent (dom-parent target)))
|
||||
(when parent (host-call parent "insertBefore" value target)))
|
||||
(let
|
||||
((parent (dom-parent target)))
|
||||
(do
|
||||
(dom-insert-adjacent-html target "beforebegin" value)
|
||||
(when parent (hs-boot-subtree! parent))))))
|
||||
((= pos "after")
|
||||
(if
|
||||
(hs-element? value)
|
||||
(let
|
||||
((parent (dom-parent target))
|
||||
(next (host-get target "nextSibling")))
|
||||
(when
|
||||
parent
|
||||
(if
|
||||
next
|
||||
(host-call parent "insertBefore" value next)
|
||||
(host-call parent "appendChild" value))))
|
||||
(let
|
||||
((parent (dom-parent target)))
|
||||
(do
|
||||
(dom-insert-adjacent-html target "afterend" value)
|
||||
(when parent (hs-boot-subtree! parent))))))
|
||||
((= pos "start")
|
||||
(cond
|
||||
((list? target) (append! target value 0))
|
||||
((hs-element? value) (dom-prepend target value))
|
||||
(true
|
||||
(do
|
||||
(dom-insert-adjacent-html target "afterbegin" value)
|
||||
(hs-boot-subtree! target)))))
|
||||
((= pos "end")
|
||||
(cond
|
||||
((list? target) (append! target value))
|
||||
((hs-element? value) (dom-append target value))
|
||||
(true
|
||||
(do
|
||||
(dom-insert-adjacent-html target "beforeend" value)
|
||||
(hs-boot-subtree! target)))))))))
|
||||
|
||||
;; Last element matching selector.
|
||||
(define
|
||||
@@ -228,16 +279,22 @@
|
||||
(define
|
||||
hs-halt!
|
||||
(fn
|
||||
(mode)
|
||||
(when
|
||||
event
|
||||
(cond
|
||||
((= mode "default") (host-call event "preventDefault"))
|
||||
((= mode "bubbling") (host-call event "stopPropagation"))
|
||||
(true
|
||||
(do
|
||||
(host-call event "preventDefault")
|
||||
(host-call event "stopPropagation")))))))
|
||||
(ev mode)
|
||||
(do
|
||||
(when
|
||||
ev
|
||||
(cond
|
||||
((= mode "default") (host-call ev "preventDefault"))
|
||||
((= mode "bubbling") (host-call ev "stopPropagation"))
|
||||
((= mode "the-event")
|
||||
(do
|
||||
(host-call ev "preventDefault")
|
||||
(host-call ev "stopPropagation")))
|
||||
(true
|
||||
(do
|
||||
(host-call ev "preventDefault")
|
||||
(host-call ev "stopPropagation")))))
|
||||
(when (not (= mode "the-event")) (raise (list "hs-return" nil))))))
|
||||
|
||||
;; ── Type coercion ───────────────────────────────────────────────
|
||||
|
||||
@@ -249,7 +306,51 @@
|
||||
|
||||
;; Make a new object of a given type.
|
||||
;; (hs-make type-name) — creates empty object/collection
|
||||
(define hs-reset! (fn (target) (host-call target "reset" (list))))
|
||||
(define
|
||||
hs-reset!
|
||||
(fn
|
||||
(target)
|
||||
(cond
|
||||
((list? target) (for-each (fn (el) (hs-reset! el)) target))
|
||||
((nil? target) nil)
|
||||
(true
|
||||
(let
|
||||
((tag (dom-get-prop target "tagName")))
|
||||
(cond
|
||||
((= tag "FORM") (host-call target "reset" (list)))
|
||||
((or (= tag "INPUT") (= tag "TEXTAREA"))
|
||||
(let
|
||||
((input-type (dom-get-prop target "type")))
|
||||
(cond
|
||||
((or (= input-type "checkbox") (= input-type "radio"))
|
||||
(dom-set-prop
|
||||
target
|
||||
"checked"
|
||||
(dom-get-prop target "defaultChecked")))
|
||||
(true
|
||||
(dom-set-prop
|
||||
target
|
||||
"value"
|
||||
(dom-get-prop target "defaultValue"))))))
|
||||
((= tag "SELECT")
|
||||
(let
|
||||
((options (host-call target "querySelectorAll" "option"))
|
||||
(default-val nil))
|
||||
(do
|
||||
(for-each
|
||||
(fn
|
||||
(opt)
|
||||
(when
|
||||
(and
|
||||
(nil? default-val)
|
||||
(dom-get-prop opt "defaultSelected"))
|
||||
(set! default-val (dom-get-prop opt "value"))))
|
||||
options)
|
||||
(when
|
||||
(and (nil? default-val) (> (len options) 0))
|
||||
(set! default-val (dom-get-prop (first options) "value")))
|
||||
(when default-val (dom-set-prop target "value" default-val)))))
|
||||
(true nil)))))))
|
||||
|
||||
;; ── Behavior installation ───────────────────────────────────────
|
||||
|
||||
@@ -306,6 +407,20 @@
|
||||
hs-query-all
|
||||
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
|
||||
|
||||
(define
|
||||
hs-list-set
|
||||
(fn (lst idx val) (map-indexed (fn (i x) (if (= i idx) val x)) lst)))
|
||||
|
||||
(define
|
||||
hs-to-number
|
||||
(fn
|
||||
(v)
|
||||
(cond
|
||||
((number? v) v)
|
||||
((string? v) (or (parse-number v) 0))
|
||||
((nil? v) 0)
|
||||
(true (or (parse-number (str v)) 0)))))
|
||||
|
||||
(define
|
||||
hs-query-first
|
||||
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
|
||||
@@ -387,6 +502,10 @@
|
||||
(if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
|
||||
(true (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define
|
||||
hs-for-each
|
||||
(fn
|
||||
@@ -419,17 +538,14 @@
|
||||
(define
|
||||
hs-append!
|
||||
(fn (value target) (dom-insert-adjacent-html target "beforeend" value))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
(define
|
||||
hs-fetch
|
||||
(fn
|
||||
(url format)
|
||||
(perform (list "io-fetch" url (if format format "text")))))
|
||||
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
(define
|
||||
hs-coerce
|
||||
(fn
|
||||
@@ -520,8 +636,7 @@
|
||||
(map (fn (k) (list k (get value k))) (keys value))
|
||||
value))
|
||||
(true value))))
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
;; Method dispatch — obj.method(args)
|
||||
(define
|
||||
hs-add
|
||||
(fn
|
||||
@@ -531,7 +646,9 @@
|
||||
((list? b) (cons a b))
|
||||
((or (string? a) (string? b)) (str a b))
|
||||
(true (+ a b)))))
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
(define
|
||||
hs-make
|
||||
(fn
|
||||
@@ -542,15 +659,13 @@
|
||||
((= type-name "Set") (list))
|
||||
((= type-name "Map") (dict))
|
||||
(true (dict)))))
|
||||
;; Method dispatch — obj.method(args)
|
||||
;; Property-based is — check obj.key truthiness
|
||||
(define hs-install (fn (behavior-fn) (behavior-fn me)))
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
;; Array slicing (inclusive both ends)
|
||||
(define
|
||||
hs-measure
|
||||
(fn (target) (perform (list (quote io-measure) target))))
|
||||
;; Property-based is — check obj.key truthiness
|
||||
;; Collection: sorted by
|
||||
(define
|
||||
hs-transition
|
||||
(fn
|
||||
@@ -563,7 +678,7 @@
|
||||
(str prop " " (/ duration 1000) "s")))
|
||||
(dom-set-style target prop value)
|
||||
(when duration (hs-settle target))))
|
||||
;; Array slicing (inclusive both ends)
|
||||
;; Collection: sorted by descending
|
||||
(define
|
||||
hs-transition-from
|
||||
(fn
|
||||
@@ -577,7 +692,7 @@
|
||||
(str prop " " (/ duration 1000) "s")))
|
||||
(dom-set-style target prop (str to-val))
|
||||
(when duration (hs-settle target))))
|
||||
;; Collection: sorted by
|
||||
;; Collection: split by
|
||||
(define
|
||||
hs-type-check
|
||||
(fn
|
||||
@@ -597,17 +712,17 @@
|
||||
(= (host-typeof value) "element")
|
||||
(= (host-typeof value) "text")))
|
||||
(true (= (host-typeof value) (downcase type-name)))))))
|
||||
;; Collection: sorted by descending
|
||||
;; Collection: joined by
|
||||
(define
|
||||
hs-type-check-strict
|
||||
(fn
|
||||
(value type-name)
|
||||
(if (nil? value) false (hs-type-check value type-name))))
|
||||
;; Collection: split by
|
||||
|
||||
(define
|
||||
hs-strict-eq
|
||||
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
|
||||
;; Collection: joined by
|
||||
|
||||
(define
|
||||
hs-eq-ignore-case
|
||||
(fn (a b) (= (downcase (str a)) (downcase (str b)))))
|
||||
@@ -738,6 +853,17 @@
|
||||
((dict? v) (= (len (keys v)) 0))
|
||||
(true false))))
|
||||
|
||||
(define
|
||||
hs-empty-like
|
||||
(fn
|
||||
(v)
|
||||
(cond
|
||||
((list? v) (list))
|
||||
((dict? v) (dict))
|
||||
((string? v) "")
|
||||
((nil? v) nil)
|
||||
(true v))))
|
||||
|
||||
(define
|
||||
hs-empty-target!
|
||||
(fn
|
||||
@@ -756,7 +882,6 @@
|
||||
(or (= input-type "checkbox") (= input-type "radio"))
|
||||
(dom-set-prop target "checked" false)
|
||||
(dom-set-prop target "value" ""))))
|
||||
((= tag "FORM") (dom-set-inner-html target ""))
|
||||
((= tag "FORM")
|
||||
(let
|
||||
((children (host-call target "querySelectorAll" "input, textarea, select")))
|
||||
@@ -981,10 +1106,10 @@
|
||||
(el)
|
||||
(let
|
||||
((tag (dom-get-prop el "tagName")))
|
||||
(if
|
||||
(= tag "DIALOG")
|
||||
(host-call el "showModal")
|
||||
(dom-set-prop el "open" true)))))
|
||||
(cond
|
||||
((= tag "DIALOG") (host-call el "showModal"))
|
||||
(true
|
||||
(do (dom-set-attr el "open" "") (dom-set-prop el "open" true)))))))
|
||||
|
||||
(define
|
||||
hs-close!
|
||||
@@ -992,10 +1117,12 @@
|
||||
(el)
|
||||
(let
|
||||
((tag (dom-get-prop el "tagName")))
|
||||
(if
|
||||
(= tag "DIALOG")
|
||||
(host-call el "close")
|
||||
(dom-set-prop el "open" false)))))
|
||||
(cond
|
||||
((= tag "DIALOG") (host-call el "close"))
|
||||
(true
|
||||
(do
|
||||
(host-call el "removeAttribute" "open")
|
||||
(dom-set-prop el "open" false)))))))
|
||||
|
||||
(define
|
||||
hs-hide!
|
||||
|
||||
Reference in New Issue
Block a user