HS: custom conversion API + asExpression tests (+2)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 39s

Add _hs-custom-conversions dict and _hs-dynamic-converters list to
runtime.sx. hs-set-conversion!/hs-clear-conversion!/hs-add-dynamic-converter!/
hs-pop-dynamic-converter!/hs-clear-converters! helpers expose the API.
hs-coerce fallback now checks static dict then dynamic resolvers before
returning value unchanged.

Hand-roll MANUAL_TEST_BODIES for "can accept custom conversions" and
"can accept custom dynamic conversions" — previously SKIP (untranslated).

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
2026-05-05 22:35:42 +00:00
parent 2f8abb18a3
commit 0753982a02
4 changed files with 183 additions and 34 deletions

View File

@@ -1156,6 +1156,41 @@
"}")))
(true (hs-json-escape (str v))))))
(begin
(define _hs-custom-conversions {})
(define _hs-dynamic-converters (list))
(define
hs-set-conversion!
(fn (name conv-fn) (dict-set! _hs-custom-conversions name conv-fn)))
(define
hs-clear-conversion!
(fn (name) (dict-set! _hs-custom-conversions name nil)))
(define
hs-add-dynamic-converter!
(fn
(conv-fn)
(set!
_hs-dynamic-converters
(append _hs-dynamic-converters (list conv-fn)))))
(define
hs-pop-dynamic-converter!
(fn
()
(let
((n (len _hs-dynamic-converters)))
(when
(> n 0)
(set!
_hs-dynamic-converters
(slice _hs-dynamic-converters 0 (- n 1)))))))
(define
hs-clear-converters!
(fn
()
(do
(set! _hs-custom-conversions {})
(set! _hs-dynamic-converters (list))))))
(define
hs-coerce
(fn
@@ -1280,7 +1315,15 @@
(filter (fn (k) (not (= k "_order"))) (keys value))))
m)))
((= type-name "Date") (host-new "Date" value))
(true value))))
(true
(let
((static-fn (get _hs-custom-conversions type-name)))
(if
(not (nil? static-fn))
(static-fn value)
(let
((dynamic-result (reduce (fn (acc resolver) (if (not (nil? acc)) acc (resolver type-name value))) nil _hs-dynamic-converters)))
(if (not (nil? dynamic-result)) dynamic-result value))))))))
(define
hs-gather-form-nodes
@@ -2722,6 +2765,8 @@
((store (host-get el "__hs_vars")))
(if (nil? store) nil (host-get store name)))))
;; ── SourceInfo API ────────────────────────────────────────────────
(define
hs-dom-set-var-raw!
(fn
@@ -2735,8 +2780,6 @@
(host-set! (host-get el "__hs_vars") name val)
(when changed (hs-dom-fire-watchers! el name val))))))
;; ── SourceInfo API ────────────────────────────────────────────────
(define
hs-dom-resolve-start
(fn

View File

@@ -411,7 +411,7 @@
(do
(dom-set-inner-html target value)
(hs-boot-subtree! target)))))
((= pos "beforebegin")
((or (= pos "beforebegin") (= pos "before"))
(if
(hs-element? value)
(let
@@ -422,7 +422,7 @@
(do
(dom-insert-adjacent-html target "beforebegin" value)
(when parent (hs-boot-subtree! parent))))))
((= pos "afterend")
((or (= pos "afterend") (= pos "after"))
(if
(hs-element? value)
(let
@@ -439,7 +439,7 @@
(do
(dom-insert-adjacent-html target "afterend" value)
(when parent (hs-boot-subtree! parent))))))
((= pos "afterbegin")
((or (= pos "afterbegin") (= pos "start"))
(cond
((list? value) (append! target value 0))
((hs-element? value) (dom-prepend target value))
@@ -447,7 +447,7 @@
(do
(dom-insert-adjacent-html target "afterbegin" value)
(hs-boot-subtree! target)))))
((= pos "beforeend")
((or (= pos "beforeend") (= pos "end"))
(cond
((list? value) (append! target value))
((hs-element? value) (dom-append target value))
@@ -470,6 +470,7 @@
(some (fn (x) (= x value)) target)
target
(append target (list value))))
((hs-is-set? target) (do (host-call target "add" value) target))
(true (do (host-call target "push" value) target)))))
;; ── Object creation ─────────────────────────────────────────────
@@ -480,10 +481,10 @@
hs-remove-from!
(fn
(value target)
(if
(list? target)
(filter (fn (x) (not (= x value))) target)
(host-call target "splice" (host-call target "indexOf" value) 1))))
(cond
((list? target) (filter (fn (x) (not (= x value))) target))
((hs-is-set? target) (do (host-call target "delete" value) target))
(true (host-call target "splice" (host-call target "indexOf" value) 1)))))
;; ── Behavior installation ───────────────────────────────────────
@@ -965,6 +966,7 @@
(some (fn (x) (= x value)) target)
target
(append target (list value))))
((hs-is-set? target) (do (host-call target "add" value) target))
((hs-element? target)
(do
(dom-insert-adjacent-html
@@ -998,7 +1000,7 @@
(event)
(let
((detail (host-get event "detail")))
(if detail (host-get detail "sender") nil))))
(if detail (get detail "sender") nil))))
(define
hs-host-to-sx
@@ -1154,6 +1156,41 @@
"}")))
(true (hs-json-escape (str v))))))
(begin
(define _hs-custom-conversions {})
(define _hs-dynamic-converters (list))
(define
hs-set-conversion!
(fn (name conv-fn) (dict-set! _hs-custom-conversions name conv-fn)))
(define
hs-clear-conversion!
(fn (name) (dict-set! _hs-custom-conversions name nil)))
(define
hs-add-dynamic-converter!
(fn
(conv-fn)
(set!
_hs-dynamic-converters
(append _hs-dynamic-converters (list conv-fn)))))
(define
hs-pop-dynamic-converter!
(fn
()
(let
((n (len _hs-dynamic-converters)))
(when
(> n 0)
(set!
_hs-dynamic-converters
(slice _hs-dynamic-converters 0 (- n 1)))))))
(define
hs-clear-converters!
(fn
()
(do
(set! _hs-custom-conversions {})
(set! _hs-dynamic-converters (list))))))
(define
hs-coerce
(fn
@@ -1260,23 +1297,33 @@
value)
value))
((= type-name "Set")
(if
(list? value)
(reduce
(fn
(acc x)
(if (some (fn (a) (= a x)) acc) acc (append acc (list x))))
(list)
value)
value))
(let
((s (host-new "Set")))
(do
(when
(list? value)
(for-each (fn (x) (host-call s "add" x)) value))
s)))
((= type-name "Map")
(if
(dict? value)
(let
((ks (if (dict-has? value "_order") (get value "_order") (filter (fn (k) (not (= k "_order"))) (keys value)))))
(map (fn (k) (list k (get value k))) ks))
value))
(true value))))
(let
((m (host-new "Map")))
(do
(when
(dict? value)
(for-each
(fn (k) (host-call m "set" k (get value k)))
(filter (fn (k) (not (= k "_order"))) (keys value))))
m)))
((= type-name "Date") (host-new "Date" value))
(true
(let
((static-fn (get _hs-custom-conversions type-name)))
(if
(not (nil? static-fn))
(static-fn value)
(let
((dynamic-result (reduce (fn (acc resolver) (if (not (nil? acc)) acc (resolver type-name value))) nil _hs-dynamic-converters)))
(if (not (nil? dynamic-result)) dynamic-result value))))))))
(define
hs-gather-form-nodes
@@ -1471,8 +1518,8 @@
(cond
((= type-name "Object") (dict))
((= type-name "Array") (list))
((= type-name "Set") (list))
((= type-name "Map") (dict))
((= type-name "Set") (host-new "Set"))
((= type-name "Map") (host-new "Map"))
(true (dict)))
(apply host-new (cons type-name args)))))))
(define
@@ -1871,6 +1918,8 @@
(cond
((list? v) (list))
((dict? v) (dict))
((hs-is-set? v) (host-new "Set"))
((hs-is-map? v) (host-new "Map"))
((string? v) "")
((nil? v) nil)
(true v))))
@@ -2386,6 +2435,26 @@
pairs)
d))))
(define
hs-strip-order-deep
(fn
(val)
(cond
((dict? val)
(let
((d (dict)))
(do
(for-each
(fn
(k)
(when
(not (= k "_order"))
(dict-set! d k (hs-strip-order-deep (get val k)))))
(filter (fn (k) (not (= k "_order"))) (keys val)))
d)))
((list? val) (map hs-strip-order-deep val))
(true val))))
(define
hs-method-call
(fn
@@ -2696,6 +2765,8 @@
((store (host-get el "__hs_vars")))
(if (nil? store) nil (host-get store name)))))
;; ── SourceInfo API ────────────────────────────────────────────────
(define
hs-dom-set-var-raw!
(fn
@@ -2728,8 +2799,6 @@
(if match (dom-parent match) nil)))
(true el))))))
;; ── SourceInfo API ────────────────────────────────────────────────
(define
hs-dom-walk
(fn

View File

@@ -3724,9 +3724,25 @@
;; ── expressions/asExpression (42 tests) ──
(defsuite "hs-upstream-expressions/asExpression"
(deftest "can accept custom conversions"
(error "SKIP (untranslated): can accept custom conversions"))
(do
(hs-set-conversion! "Foo" (fn (val) (str "foo" (str val))))
(let ((result (hs-coerce 1 "Foo")))
(do
(hs-clear-conversion! "Foo")
(assert= result "foo1"))))
)
(deftest "can accept custom dynamic conversions"
(error "SKIP (untranslated): can accept custom dynamic conversions"))
(do
(hs-add-dynamic-converter!
(fn (conversion val)
(if (= (host-call conversion "indexOf" "Foo:") 0)
(str (host-call conversion "slice" 4) (str val))
nil)))
(let ((result (hs-coerce 1 "Foo:Bar")))
(do
(hs-pop-dynamic-converter!)
(assert= result "Bar1"))))
)
(deftest "can use the a modifier if you like"
(let ((_result (eval-hs "1 as a Date")))
(assert= (host-call _result "getTime") 1))

View File

@@ -326,6 +326,27 @@ MANUAL_TEST_BODIES = {
' (list (list (quote record) record)))',
' "<div age=\\"21\\" style=\\"color:bleaux\\">John Connor</div>"))',
],
# asExpression: custom conversions — set/clear via hs-set-conversion! + hs-add-dynamic-converter!
"can accept custom conversions": [
' (do',
' (hs-set-conversion! "Foo" (fn (val) (str "foo" (str val))))',
' (let ((result (hs-coerce 1 "Foo")))',
' (do',
' (hs-clear-conversion! "Foo")',
' (assert= result "foo1"))))',
],
"can accept custom dynamic conversions": [
' (do',
' (hs-add-dynamic-converter!',
' (fn (conversion val)',
' (if (= (host-call conversion "indexOf" "Foo:") 0)',
' (str (host-call conversion "slice" 4) (str val))',
' nil)))',
' (let ((result (hs-coerce 1 "Foo:Bar")))',
' (do',
' (hs-pop-dynamic-converter!)',
' (assert= result "Bar1"))))',
],
# asExpression: Date/Set/Map need real JS host objects
"converts value as Date": [
' (let ((_result (eval-hs "1 as Date")))',