HS runtime + generator: make, Values, toggle styles, scoped storage, array ops, fetch coercion, scripts in PW bodies
Runtime (lib/hyperscript/ + shared/static/wasm/sx/hs-*.sx):
- make: parser accepts `<tag.class#id/>` selectors and `from <expr>,…`; compiler
emits via scoped-set so `called <name>` persists; `called $X` lands on
window; runtime dispatches element vs host-new constructor by type.
- Values: `x as Values` walks form inputs/selects/textareas, producing
{name: value | [value,…]}; duplicates promote to array; multi-select and
checkbox/radio handled.
- toggle *display/*visibility/*opacity: paired with sensible inline defaults
in the mock DOM so toggle flips block/visible/1 ↔ none/hidden/0.
- add/remove/put at array: emit-set paths route list mutations back through
the scoped binding; add hs-put-at! / hs-splice-at! / hs-dict-without.
- remove OBJ.KEY / KEY of OBJ: rebuild dict via hs-dict-without and reassign,
since SX dicts are copy-on-read across the bridge.
- dom-set-data: use (host-new "Object") rather than (dict) so element-local
storage actually persists between reads.
- fetch: hs-fetch normalizes JSON/Object/Text/Response format aliases;
compiler sets `the-result` when wrapping a fetch in the `let ((it …))`
chain, and __get-cmd shares one evaluation via __hs-g.
Mock DOM (tests/hs-run-filtered.js):
- parseHTMLFragments accepts void elements (<input>, <br>, …);
- setAttribute tracks name/type/checked/selected/multiple;
- select.options populated on appendChild;
- insertAdjacentHTML parses fragments and inserts real El children into the
parent so HS-activated handlers attach.
Generator (tests/playwright/generate-sx-tests.py):
- process_hs_val strips `//` / `--` line comments before newline→then
collapse, and strips spurious `then` before else/end/catch/finally.
- parse_dev_body interleaves window-setup ops and DOM resets between
actions/assertions; pre-html setups still emit up front.
- generate_test_pw compiles any `<script type=text/hyperscript>` (flattened
across JS string-concat) under guard, exposing def blocks.
- Ordered ops for `run()`-style tests check window.obj.prop via new
_js_window_expr_to_sx; add DOM-constructing evaluate + _hyperscript
pattern for `as Values` tests (result.key[i].toBe(…)).
- js_val_to_sx handles backticks and escapes embedded quotes.
Net delta across suites:
- if 16→18, make 0→8, toggle 12→21, add 9→10, remove 11→16, put 29→31,
fetch 11→15, repeat 14→26, expressions/asExpression 20→25, set 27→28,
core/scoping 12→14, when 39→39 (no regression).
🤖 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:
@@ -435,7 +435,7 @@
|
||||
(el key val)
|
||||
(when
|
||||
(not (host-get el "__sx_data"))
|
||||
(host-set! el "__sx_data" (dict)))
|
||||
(host-set! el "__sx_data" (host-new "Object")))
|
||||
(host-set! (host-get el "__sx_data") key val)))
|
||||
(define
|
||||
dom-append-to-head
|
||||
|
||||
@@ -353,16 +353,41 @@
|
||||
emit-make
|
||||
(fn
|
||||
(ast)
|
||||
(if
|
||||
(= (len ast) 3)
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(make-symbol (nth ast 2))
|
||||
(list (quote hs-make) (nth ast 1))))
|
||||
(make-symbol (nth ast 2)))
|
||||
(list (quote hs-make) (nth ast 1)))))
|
||||
(let
|
||||
((type-name (nth ast 1))
|
||||
(called (if (>= (len ast) 3) (nth ast 2) nil))
|
||||
(args (if (>= (len ast) 4) (nth ast 3) nil))
|
||||
(kind (if (>= (len ast) 5) (nth ast 4) (quote auto))))
|
||||
(let
|
||||
((make-call (cond ((nil? args) (list (quote hs-make) type-name)) (true (cons (quote hs-make) (cons type-name (map hs-to-sx args)))))))
|
||||
(cond
|
||||
((and called (> (len called) 1) (= (substring called 0 1) "$"))
|
||||
(list
|
||||
(quote let)
|
||||
(list (list (quote __hs-mk) make-call))
|
||||
(list
|
||||
(quote do)
|
||||
(list
|
||||
(quote host-set!)
|
||||
(list (quote host-global) "window")
|
||||
called
|
||||
(quote __hs-mk))
|
||||
(list (quote set!) (quote it) (quote __hs-mk))
|
||||
(quote __hs-mk))))
|
||||
(called
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote set!) (make-symbol called) make-call)
|
||||
(list (quote set!) (quote it) (make-symbol called))
|
||||
(make-symbol called)))
|
||||
(true
|
||||
(list
|
||||
(quote let)
|
||||
(list (list (quote __hs-mk) make-call))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote set!) (quote it) (quote __hs-mk))
|
||||
(quote __hs-mk)))))))))
|
||||
(define
|
||||
emit-inc
|
||||
(fn
|
||||
@@ -1182,13 +1207,38 @@
|
||||
(if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt))
|
||||
(nth ast 1)))))
|
||||
((= head (quote remove-element))
|
||||
(list (quote dom-remove) (hs-to-sx (nth ast 1))))
|
||||
(let
|
||||
((tgt (nth ast 1)))
|
||||
(cond
|
||||
((and (list? tgt) (= (first tgt) (quote array-index)))
|
||||
(let
|
||||
((coll (nth tgt 1)) (idx (hs-to-sx (nth tgt 2))))
|
||||
(emit-set
|
||||
coll
|
||||
(list (quote hs-splice-at!) (hs-to-sx coll) idx))))
|
||||
((and (list? tgt) (= (first tgt) dot-sym))
|
||||
(let
|
||||
((obj (nth tgt 1)) (prop (nth tgt 2)))
|
||||
(emit-set
|
||||
obj
|
||||
(list (quote hs-dict-without) (hs-to-sx obj) prop))))
|
||||
((and (list? tgt) (= (first tgt) (quote of)))
|
||||
(let
|
||||
((prop-ast (nth tgt 1)) (obj-ast (nth tgt 2)))
|
||||
(let
|
||||
((prop (cond ((string? prop-ast) prop-ast) ((and (list? prop-ast) (= (first prop-ast) (quote ref))) (nth prop-ast 1)) (true (hs-to-sx prop-ast)))))
|
||||
(emit-set
|
||||
obj-ast
|
||||
(list
|
||||
(quote hs-dict-without)
|
||||
(hs-to-sx obj-ast)
|
||||
prop)))))
|
||||
(true (list (quote dom-remove) (hs-to-sx tgt))))))
|
||||
((= head (quote add-value))
|
||||
(let
|
||||
((val (hs-to-sx (nth ast 1))) (tgt (nth ast 2)))
|
||||
(list
|
||||
(quote set!)
|
||||
(hs-to-sx tgt)
|
||||
(emit-set
|
||||
tgt
|
||||
(list (quote hs-add-to!) val (hs-to-sx tgt)))))
|
||||
((= head (quote add-attr))
|
||||
(let
|
||||
@@ -1201,9 +1251,8 @@
|
||||
((= head (quote remove-value))
|
||||
(let
|
||||
((val (hs-to-sx (nth ast 1))) (tgt (nth ast 2)))
|
||||
(list
|
||||
(quote set!)
|
||||
(hs-to-sx tgt)
|
||||
(emit-set
|
||||
tgt
|
||||
(list (quote hs-remove-from!) val (hs-to-sx tgt)))))
|
||||
((= head (quote empty-target))
|
||||
(let
|
||||
@@ -1348,11 +1397,16 @@
|
||||
((= head (quote set!))
|
||||
(emit-set (nth ast 1) (hs-to-sx (nth ast 2))))
|
||||
((= head (quote put!))
|
||||
(list
|
||||
(quote hs-put!)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(nth ast 2)
|
||||
(hs-to-sx (nth ast 3))))
|
||||
(let
|
||||
((val (hs-to-sx (nth ast 1)))
|
||||
(pos (nth ast 2))
|
||||
(raw-tgt (nth ast 3)))
|
||||
(cond
|
||||
((and (or (= pos "end") (= pos "start")) (list? raw-tgt) (or (= (first raw-tgt) (quote local)) (= (first raw-tgt) (quote ref))))
|
||||
(emit-set
|
||||
raw-tgt
|
||||
(list (quote hs-put-at!) val pos (hs-to-sx raw-tgt))))
|
||||
(true (list (quote hs-put!) val pos (hs-to-sx raw-tgt))))))
|
||||
((= head (quote if))
|
||||
(if
|
||||
(> (len ast) 3)
|
||||
@@ -1387,10 +1441,24 @@
|
||||
(reduce
|
||||
(fn
|
||||
(body cmd)
|
||||
(list
|
||||
(quote let)
|
||||
(list (list (quote it) cmd))
|
||||
body))
|
||||
(if
|
||||
(and
|
||||
(list? cmd)
|
||||
(= (first cmd) (quote hs-fetch)))
|
||||
(list
|
||||
(quote let)
|
||||
(list (list (quote it) cmd))
|
||||
(list
|
||||
(quote begin)
|
||||
(list
|
||||
(quote set!)
|
||||
(quote the-result)
|
||||
(quote it))
|
||||
body))
|
||||
(list
|
||||
(quote let)
|
||||
(list (list (quote it) cmd))
|
||||
body)))
|
||||
(nth compiled (- (len compiled) 1))
|
||||
(rest (reverse compiled)))
|
||||
(cons (quote do) compiled))))
|
||||
@@ -1512,10 +1580,13 @@
|
||||
(let
|
||||
((val (hs-to-sx (nth ast 1))))
|
||||
(list
|
||||
(quote begin)
|
||||
(list (quote set!) (quote the-result) val)
|
||||
(list (quote set!) (quote it) val)
|
||||
val)))
|
||||
(quote let)
|
||||
(list (list (quote __hs-g) val))
|
||||
(list
|
||||
(quote begin)
|
||||
(list (quote set!) (quote the-result) (quote __hs-g))
|
||||
(list (quote set!) (quote it) (quote __hs-g))
|
||||
(quote __hs-g)))))
|
||||
((= head (quote append!))
|
||||
(let
|
||||
((tgt (hs-to-sx (nth ast 2)))
|
||||
|
||||
@@ -1975,14 +1975,29 @@
|
||||
()
|
||||
(if (= (tp-val) "a") (adv!) nil)
|
||||
(let
|
||||
((type-name (tp-val)))
|
||||
((kind (if (= (tp-type) "selector") (quote element) (quote object)))
|
||||
(type-name (tp-val)))
|
||||
(adv!)
|
||||
(let
|
||||
((called (if (match-kw "called") (let ((n (tp-val))) (adv!) n) nil)))
|
||||
(if
|
||||
called
|
||||
(list (quote make) type-name called)
|
||||
(list (quote make) type-name))))))
|
||||
((called nil) (args nil))
|
||||
(define
|
||||
parse-from-args
|
||||
(fn
|
||||
()
|
||||
(set! args (append args (list (parse-expr))))
|
||||
(when (= (tp-type) "comma") (adv!) (parse-from-args))))
|
||||
(define
|
||||
parse-clauses
|
||||
(fn
|
||||
()
|
||||
(cond
|
||||
((match-kw "from")
|
||||
(do (parse-from-args) (parse-clauses)))
|
||||
((match-kw "called")
|
||||
(do (set! called (tp-val)) (adv!) (parse-clauses)))
|
||||
(true nil))))
|
||||
(parse-clauses)
|
||||
(list (quote make) type-name called args kind)))))
|
||||
(define
|
||||
parse-install-cmd
|
||||
(fn
|
||||
|
||||
@@ -293,18 +293,91 @@
|
||||
(filter (fn (x) (not (= x value))) target)
|
||||
(host-call target "splice" (host-call target "indexOf" value) 1))))
|
||||
|
||||
(define
|
||||
hs-splice-at!
|
||||
(fn
|
||||
(target idx)
|
||||
(if
|
||||
(list? target)
|
||||
(let
|
||||
((n (len target)))
|
||||
(let
|
||||
((i (if (< idx 0) (+ n idx) idx)))
|
||||
(cond
|
||||
((or (< i 0) (>= i n)) target)
|
||||
(true (concat (slice target 0 i) (slice target (+ i 1) n))))))
|
||||
(do
|
||||
(when
|
||||
target
|
||||
(let
|
||||
((n (host-get target "length")))
|
||||
(let
|
||||
((i (if (< idx 0) (+ (if (nil? n) 0 n) idx) idx)))
|
||||
(host-call target "splice" i 1))))
|
||||
target))))
|
||||
|
||||
;; ── Iteration ───────────────────────────────────────────────────
|
||||
|
||||
;; Repeat a thunk N times.
|
||||
(define
|
||||
hs-put-at!
|
||||
(fn
|
||||
(value pos target)
|
||||
(cond
|
||||
((nil? target) (list value))
|
||||
((list? target)
|
||||
(if
|
||||
(= pos "start")
|
||||
(cons value target)
|
||||
(append target (list value))))
|
||||
(true
|
||||
(do
|
||||
(cond
|
||||
((= pos "end") (host-call target "push" value))
|
||||
((= pos "start") (host-call target "unshift" value)))
|
||||
target)))))
|
||||
|
||||
;; Repeat forever (until break — relies on exception/continuation).
|
||||
(define
|
||||
hs-dict-without
|
||||
(fn
|
||||
(obj key)
|
||||
(cond
|
||||
((nil? obj) (dict))
|
||||
((dict? obj)
|
||||
(let
|
||||
((out (dict)))
|
||||
(for-each
|
||||
(fn (k) (when (not (= k key)) (dict-set! out k (get obj k))))
|
||||
(keys obj))
|
||||
out))
|
||||
(true
|
||||
(let
|
||||
((out (dict)))
|
||||
(host-call (host-global "Object") "assign" out obj)
|
||||
(host-call (host-global "Reflect") "deleteProperty" out key)
|
||||
out)))))
|
||||
|
||||
;; ── Fetch ───────────────────────────────────────────────────────
|
||||
|
||||
;; Fetch a URL, parse response according to format.
|
||||
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
||||
(define
|
||||
hs-set-on!
|
||||
(fn
|
||||
(props target)
|
||||
(for-each (fn (k) (host-set! target k (get props k))) (keys props))))
|
||||
|
||||
;; ── Iteration ───────────────────────────────────────────────────
|
||||
;; ── Type coercion ───────────────────────────────────────────────
|
||||
|
||||
;; Repeat a thunk N times.
|
||||
;; 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))))
|
||||
|
||||
;; Repeat forever (until break — relies on exception/continuation).
|
||||
;; ── Object creation ─────────────────────────────────────────────
|
||||
|
||||
;; Make a new object of a given type.
|
||||
;; (hs-make type-name) — creates empty object/collection
|
||||
(define
|
||||
hs-scroll!
|
||||
(fn
|
||||
@@ -317,10 +390,11 @@
|
||||
((= position "bottom") (dict :block "end"))
|
||||
(true (dict :block "start")))))))
|
||||
|
||||
;; ── Fetch ───────────────────────────────────────────────────────
|
||||
;; ── Behavior installation ───────────────────────────────────────
|
||||
|
||||
;; Fetch a URL, parse response according to format.
|
||||
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
||||
;; 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-halt!
|
||||
(fn
|
||||
@@ -341,16 +415,16 @@
|
||||
(host-call ev "stopPropagation")))))
|
||||
(when (not (= mode "the-event")) (raise (list "hs-return" nil))))))
|
||||
|
||||
;; ── Type coercion ───────────────────────────────────────────────
|
||||
;; ── Measurement ─────────────────────────────────────────────────
|
||||
|
||||
;; Coerce a value to a type by name.
|
||||
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
||||
;; 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))))
|
||||
|
||||
;; ── Object creation ─────────────────────────────────────────────
|
||||
;; ── Transition ──────────────────────────────────────────────────
|
||||
|
||||
;; Make a new object of a given type.
|
||||
;; (hs-make type-name) — creates empty object/collection
|
||||
;; Transition a CSS property to a value, optionally with duration.
|
||||
;; (hs-transition target prop value duration)
|
||||
(define
|
||||
hs-reset!
|
||||
(fn
|
||||
@@ -397,11 +471,6 @@
|
||||
(when default-val (dom-set-prop target "value" default-val)))))
|
||||
(true nil)))))))
|
||||
|
||||
;; ── 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
|
||||
hs-next
|
||||
(fn
|
||||
@@ -421,10 +490,6 @@
|
||||
(true (find-next (dom-next-sibling el))))))
|
||||
(find-next sibling)))))
|
||||
|
||||
;; ── 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-previous
|
||||
(fn
|
||||
@@ -444,10 +509,6 @@
|
||||
(true (find-prev (dom-get-prop el "previousElementSibling"))))))
|
||||
(find-prev sibling)))))
|
||||
|
||||
;; ── Transition ──────────────────────────────────────────────────
|
||||
|
||||
;; Transition a CSS property to a value, optionally with duration.
|
||||
;; (hs-transition target prop value duration)
|
||||
(define
|
||||
hs-query-all
|
||||
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
|
||||
@@ -493,6 +554,10 @@
|
||||
((all (dom-query-all scope sel)))
|
||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define
|
||||
hs-repeat-times
|
||||
(fn
|
||||
@@ -526,7 +591,8 @@
|
||||
((= signal "hs-continue") (do-forever))
|
||||
(true (do-forever))))))
|
||||
(do-forever)))
|
||||
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
(define
|
||||
hs-repeat-while
|
||||
(fn
|
||||
@@ -539,11 +605,7 @@
|
||||
((= signal "hs-break") nil)
|
||||
((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
|
||||
(true (hs-repeat-while cond-fn thunk)))))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
(define
|
||||
hs-repeat-until
|
||||
(fn
|
||||
@@ -555,7 +617,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)))))))
|
||||
|
||||
;; Method dispatch — obj.method(args)
|
||||
(define
|
||||
hs-for-each
|
||||
(fn
|
||||
@@ -575,8 +637,9 @@
|
||||
((= signal "hs-continue") (do-loop (rest remaining)))
|
||||
(true (do-loop (rest remaining))))))))
|
||||
(do-loop items))))
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
(begin
|
||||
(define
|
||||
hs-append
|
||||
@@ -600,13 +663,15 @@
|
||||
((hs-element? target)
|
||||
(dom-insert-adjacent-html target "beforeend" (str value)))
|
||||
(true nil)))))
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
;; Property-based is — check obj.key truthiness
|
||||
(define
|
||||
hs-fetch
|
||||
(fn
|
||||
(url format)
|
||||
(perform (list "io-fetch" url (if format format "text")))))
|
||||
;; Method dispatch — obj.method(args)
|
||||
(let
|
||||
((fmt (cond ((nil? format) "text") ((or (= format "JSON") (= format "json") (= format "Object") (= format "object")) "json") ((or (= format "HTML") (= format "html")) "html") ((or (= format "Response") (= format "response")) "response") ((or (= format "Text") (= format "text")) "text") (true format))))
|
||||
(perform (list "io-fetch" url fmt)))))
|
||||
;; Array slicing (inclusive both ends)
|
||||
(define
|
||||
hs-coerce
|
||||
(fn
|
||||
@@ -649,11 +714,7 @@
|
||||
(str (/ (floor (+ (* num factor) 0.5)) factor))))))
|
||||
((= type-name "Selector") (str value))
|
||||
((= type-name "Fragment") value)
|
||||
((= type-name "Values")
|
||||
(if
|
||||
(dict? value)
|
||||
(map (fn (k) (get value k)) (keys value))
|
||||
value))
|
||||
((= type-name "Values") (hs-as-values value))
|
||||
((= type-name "Keys") (if (dict? value) (sort (keys value)) value))
|
||||
((= type-name "Entries")
|
||||
(if
|
||||
@@ -697,9 +758,126 @@
|
||||
(map (fn (k) (list k (get value k))) (keys value))
|
||||
value))
|
||||
(true value))))
|
||||
;; Collection: sorted by
|
||||
(define
|
||||
hs-gather-form-nodes
|
||||
(fn
|
||||
(root)
|
||||
(let
|
||||
((acc (list)))
|
||||
(define
|
||||
walk
|
||||
(fn
|
||||
(node)
|
||||
(let
|
||||
((tag (host-get node "tagName")))
|
||||
(cond
|
||||
((or (= tag "INPUT") (= tag "SELECT") (= tag "TEXTAREA"))
|
||||
(set! acc (append acc (list node))))
|
||||
(true
|
||||
(let
|
||||
((kids (host-get node "children")))
|
||||
(when
|
||||
(and (not (nil? kids)) (list? kids))
|
||||
(let
|
||||
((n (len kids)))
|
||||
(define
|
||||
each
|
||||
(fn
|
||||
(i)
|
||||
(when
|
||||
(< i n)
|
||||
(walk (nth kids i))
|
||||
(each (+ i 1)))))
|
||||
(each 0)))))))))
|
||||
(walk root)
|
||||
acc)))
|
||||
;; Collection: sorted by descending
|
||||
(define
|
||||
hs-values-from-nodes
|
||||
(fn (nodes) (reduce hs-values-absorb (dict) nodes)))
|
||||
;; Collection: split by
|
||||
(define
|
||||
hs-value-of-node
|
||||
(fn
|
||||
(node)
|
||||
(let
|
||||
((tag (host-get node "tagName")) (typ (host-get node "type")))
|
||||
(cond
|
||||
((= tag "SELECT")
|
||||
(if
|
||||
(host-get node "multiple")
|
||||
(hs-select-multi-values node)
|
||||
(host-get node "value")))
|
||||
((or (= typ "checkbox") (= typ "radio"))
|
||||
(if (host-get node "checked") (host-get node "value") nil))
|
||||
(true (host-get node "value"))))))
|
||||
;; Collection: joined by
|
||||
(define
|
||||
hs-select-multi-values
|
||||
(fn
|
||||
(node)
|
||||
(let
|
||||
((options (host-get node "options")) (acc (list)))
|
||||
(if
|
||||
(or (nil? options) (not (list? options)))
|
||||
acc
|
||||
(let
|
||||
((n (len options)))
|
||||
(define
|
||||
each
|
||||
(fn
|
||||
(i)
|
||||
(when
|
||||
(< i n)
|
||||
(let
|
||||
((opt (nth options i)))
|
||||
(when
|
||||
(host-get opt "selected")
|
||||
(set! acc (append acc (list (host-get opt "value"))))))
|
||||
(each (+ i 1)))))
|
||||
(each 0)
|
||||
acc)))))
|
||||
|
||||
(define
|
||||
hs-values-absorb
|
||||
(fn
|
||||
(acc node)
|
||||
(let
|
||||
((name (host-get node "name")))
|
||||
(if
|
||||
(or (nil? name) (= name ""))
|
||||
acc
|
||||
(let
|
||||
((v (hs-value-of-node node)))
|
||||
(cond
|
||||
((nil? v) acc)
|
||||
((has-key? acc name)
|
||||
(let
|
||||
((existing (get acc name)))
|
||||
(do
|
||||
(if
|
||||
(list? existing)
|
||||
(dict-set! acc name (append existing (list v)))
|
||||
(dict-set! acc name (list existing v)))
|
||||
acc)))
|
||||
(true (do (dict-set! acc name v) acc))))))))
|
||||
|
||||
(define
|
||||
hs-as-values
|
||||
(fn
|
||||
(value)
|
||||
(cond
|
||||
((nil? value) (dict))
|
||||
((list? value) (hs-values-from-nodes value))
|
||||
(true
|
||||
(let
|
||||
((tag (host-get value "tagName")))
|
||||
(cond
|
||||
((or (= tag "INPUT") (= tag "SELECT") (= tag "TEXTAREA"))
|
||||
(hs-values-from-nodes (list value)))
|
||||
(true (hs-values-from-nodes (hs-gather-form-nodes value)))))))))
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
(define
|
||||
hs-default?
|
||||
(fn
|
||||
@@ -708,13 +886,13 @@
|
||||
((nil? v) true)
|
||||
((and (string? v) (= v "")) true)
|
||||
(true false))))
|
||||
;; Property-based is — check obj.key truthiness
|
||||
|
||||
(define
|
||||
hs-array-set!
|
||||
(fn
|
||||
(arr i v)
|
||||
(if (list? arr) (do (set-nth! arr i v) v) (host-set! arr i v))))
|
||||
;; Array slicing (inclusive both ends)
|
||||
|
||||
(define
|
||||
hs-add
|
||||
(fn
|
||||
@@ -724,24 +902,117 @@
|
||||
((list? b) (cons a b))
|
||||
((or (string? a) (string? b)) (str a b))
|
||||
(true (+ a b)))))
|
||||
;; Collection: sorted by
|
||||
(define
|
||||
hs-make
|
||||
(fn
|
||||
(type-name)
|
||||
(cond
|
||||
((= type-name "Object") (dict))
|
||||
((= type-name "Array") (list))
|
||||
((= type-name "Set") (list))
|
||||
((= type-name "Map") (dict))
|
||||
(true (dict)))))
|
||||
;; Collection: sorted by descending
|
||||
|
||||
(begin
|
||||
(define
|
||||
hs-make
|
||||
(fn
|
||||
(type-name &rest args)
|
||||
(if
|
||||
(hs-make-element? type-name)
|
||||
(hs-make-element type-name)
|
||||
(let
|
||||
((ctor (host-global type-name)))
|
||||
(if
|
||||
(nil? ctor)
|
||||
(cond
|
||||
((= type-name "Object") (dict))
|
||||
((= type-name "Array") (list))
|
||||
((= type-name "Set") (list))
|
||||
((= type-name "Map") (dict))
|
||||
(true (dict)))
|
||||
(apply host-new (cons type-name args)))))))
|
||||
(define
|
||||
hs-make-element?
|
||||
(fn
|
||||
(s)
|
||||
(and
|
||||
(string? s)
|
||||
(> (len s) 0)
|
||||
(let
|
||||
((c (substring s 0 1)))
|
||||
(or
|
||||
(= c ".")
|
||||
(= c "#")
|
||||
(contains? s ".")
|
||||
(contains? s "#")
|
||||
(and (hs-lower-letter? c) (not (any-upper? s))))))))
|
||||
(define hs-lower-letter? (fn (c) (and (>= c "a") (<= c "z"))))
|
||||
(define
|
||||
any-upper?
|
||||
(fn
|
||||
(s)
|
||||
(let
|
||||
((n (len s)))
|
||||
(define
|
||||
scan
|
||||
(fn
|
||||
(i)
|
||||
(cond
|
||||
((>= i n) false)
|
||||
((and (>= (substring s i (+ i 1)) "A") (<= (substring s i (+ i 1)) "Z"))
|
||||
true)
|
||||
(true (scan (+ i 1))))))
|
||||
(scan 0))))
|
||||
(define
|
||||
hs-make-element
|
||||
(fn
|
||||
(sel)
|
||||
(let
|
||||
((parsed (hs-parse-element-selector sel)))
|
||||
(let
|
||||
((tag (get parsed "tag"))
|
||||
(id (get parsed "id"))
|
||||
(classes (get parsed "classes")))
|
||||
(let
|
||||
((el (dom-create-element (if (= tag "") "div" tag))))
|
||||
(when (and id (not (= id ""))) (dom-set-attr el "id" id))
|
||||
(for-each (fn (c) (dom-add-class el c)) classes)
|
||||
el)))))
|
||||
(define
|
||||
hs-parse-element-selector
|
||||
(fn
|
||||
(sel)
|
||||
(let
|
||||
((n (len sel))
|
||||
(tag "")
|
||||
(id "")
|
||||
(classes (list))
|
||||
(cur "")
|
||||
(mode "tag"))
|
||||
(define
|
||||
flush!
|
||||
(fn
|
||||
()
|
||||
(cond
|
||||
((= mode "tag") (set! tag cur))
|
||||
((= mode "id") (set! id cur))
|
||||
((= mode "class") (set! classes (append classes (list cur)))))
|
||||
(set! cur "")))
|
||||
(define
|
||||
walk
|
||||
(fn
|
||||
(i)
|
||||
(when
|
||||
(< i n)
|
||||
(let
|
||||
((ch (substring sel i (+ i 1))))
|
||||
(cond
|
||||
((= ch ".")
|
||||
(do (flush!) (set! mode "class") (walk (+ i 1))))
|
||||
((= ch "#")
|
||||
(do (flush!) (set! mode "id") (walk (+ i 1))))
|
||||
(true (do (set! cur (str cur ch)) (walk (+ i 1)))))))))
|
||||
(walk 0)
|
||||
(flush!)
|
||||
{:tag tag :classes classes :id id}))))
|
||||
|
||||
(define hs-install (fn (behavior-fn) (behavior-fn me)))
|
||||
;; Collection: split by
|
||||
|
||||
(define
|
||||
hs-measure
|
||||
(fn (target) (perform (list (quote io-measure) target))))
|
||||
;; Collection: joined by
|
||||
|
||||
(define
|
||||
hs-transition
|
||||
(fn
|
||||
|
||||
Reference in New Issue
Block a user