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

HS: remove bare @attr, set X @attr, JSON clean, FormEncoded, HTML join

Browse Source 
- parser remove/set: accept bare @attr (not just [@attr])
- parser set: wrap tgt as (attr name tgt) when @attr follows target
- runtime: hs-json-stringify walks sx-dict/list to emit plain JSON
  (strips _type key which leaked via JSON.stringify)
- hs-coerce JSON / JSONString: use hs-json-stringify
- hs-coerce FormEncoded: dict → k=v&... (list values repeat key)
- hs-coerce HTML: join list elements; element → outerHTML

+4 tests (button query in form, JSONString value, array→HTML,
form | JSONString now fails only on key order).

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-23 20:14:03 +00:00
parent 8984520f05
commit 6b0334affe
6 changed files with 466 additions and 82 deletions
Download Patch File Download Diff File Expand all files Collapse all files

98
shared/static/wasm/sx/hs-compiler.sx
View File

@@ -18,7 +18,17 @@
(target value)
(if
(not (list? target))
(list (quote set!) target value)
(if
(= target (quote the-result))
(list
(quote let)
(list (list (quote __hs-r) value))
(list
(quote begin)
(list (quote set!) (quote the-result) (quote __hs-r))
(list (quote set!) (quote it) (quote __hs-r))
(quote __hs-r)))
(list (quote set!) target value))
(let
((th (first target)))
(cond
@@ -1169,15 +1179,71 @@
(let
((tgt-expr (cond ((and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1))) ((and (list? raw-tgt) (= (first raw-tgt) (quote in?)) (list? (nth raw-tgt 1)) (= (first (nth raw-tgt 1)) (quote query))) (list (quote host-call) (hs-to-sx (nth raw-tgt 2)) "querySelectorAll" (nth (nth raw-tgt 1) 1))) (true (hs-to-sx raw-tgt)))))
(list
(quote for-each)
(quote let)
(list
(quote fn)
(list (quote it))
(list
(quote when)
(hs-to-sx when-cond)
(list (quote dom-add-class) (quote it) cls)))
tgt-expr))))
(quote __hs-matched)
(list
(quote filter)
(list
(quote fn)
(list (quote it))
(hs-to-sx when-cond))
tgt-expr)))
(list
(quote begin)
(list
(quote set!)
(quote the-result)
(quote __hs-matched))
(list (quote set!) (quote it) (quote __hs-matched))
(list
(quote for-each)
(list
(quote fn)
(list (quote it))
(list (quote dom-add-class) (quote it) cls))
(quote __hs-matched))
(quote __hs-matched))))))
((= head (quote add-attr-when))
(let
((attr-name (nth ast 1))
(attr-val (hs-to-sx (nth ast 2)))
(raw-tgt (nth ast 3))
(when-cond (nth ast 4)))
(let
((tgt-expr (cond ((and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1))) (true (hs-to-sx raw-tgt)))))
(list
(quote let)
(list
(list
(quote __hs-matched)
(list
(quote filter)
(list
(quote fn)
(list (quote it))
(hs-to-sx when-cond))
tgt-expr)))
(list
(quote begin)
(list
(quote set!)
(quote the-result)
(quote __hs-matched))
(list (quote set!) (quote it) (quote __hs-matched))
(list
(quote for-each)
(list
(quote fn)
(list (quote it))
(list
(quote hs-set-attr!)
(quote it)
attr-name
attr-val))
(quote __hs-matched))
(quote __hs-matched))))))
((= head (quote multi-remove-class))
(let
((target (hs-to-sx (nth ast 1)))
@@ -1598,11 +1664,17 @@
((= head (quote append!))
(let
((tgt (hs-to-sx (nth ast 2)))
(val (hs-to-sx (nth ast 1))))
(if
(symbol? tgt)
(list (quote set!) tgt (list (quote hs-append) tgt val))
(list (quote hs-append!) val tgt))))
(val (hs-to-sx (nth ast 1)))
(raw-tgt (nth ast 2)))
(cond
((symbol? tgt)
(list
(quote set!)
tgt
(list (quote hs-append) tgt val)))
((and (list? raw-tgt) (or (= (first raw-tgt) (quote local)) (= (first raw-tgt) (quote ref))))
(emit-set raw-tgt (list (quote hs-append) tgt val)))
(true (list (quote hs-append!) val tgt)))))
((= head (quote tell))
(let
((tgt (hs-to-sx (nth ast 1))))

68
shared/static/wasm/sx/hs-parser.sx
View File

@@ -954,7 +954,35 @@
(when (= (tp-type) "bracket-close") (adv!))
(let
((tgt (parse-tgt-kw "to" (list (quote me)))))
(list (quote add-attr) attr-name attr-val tgt))))))
(let
((when-clause (if (match-kw "when") (parse-expr) nil)))
(if
when-clause
(list
(quote add-attr-when)
attr-name
attr-val
tgt
when-clause)
(list (quote add-attr) attr-name attr-val tgt))))))))
((= (tp-type) "attr")
(let
((attr-name (get (adv!) "value")))
(let
((attr-val (if (and (= (tp-type) "op") (= (tp-val) "=")) (do (adv!) (parse-expr)) "")))
(let
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
(let
((when-clause (if (match-kw "when") (parse-expr) nil)))
(if
when-clause
(list
(quote add-attr-when)
attr-name
attr-val
tgt
when-clause)
(list (quote add-attr) attr-name attr-val tgt)))))))
(true
(let
((value (parse-expr)))
@@ -991,6 +1019,12 @@
(cons
(quote multi-remove-class)
(cons tgt (cons cls extra-classes)))))))
((= (tp-type) "attr")
(let
((attr-name (get (adv!) "value")))
(let
((tgt (if (match-kw "from") (parse-expr) (list (quote me)))))
(list (quote remove-attr) attr-name tgt))))
((and (= (tp-type) "bracket-open") (= (tp-val) "["))
(do
(adv!)
@@ -1276,20 +1310,24 @@
(fn
()
(let
((tgt (cond ((and (= (tp-type) "ident") (or (= (tp-val) "element") (= (tp-val) "global") (= (tp-val) "local"))) (do (adv!) (parse-expr))) (true (parse-expr)))))
(cond
((match-kw "to")
(let ((value (parse-expr))) (list (quote set!) tgt value)))
((match-kw "on")
(let
((target (parse-expr)))
(if
(match-kw "to")
(let
((value (parse-expr)))
(list (quote set-on!) tgt target value))
(list (quote set-on) tgt target))))
(true (error (str "Expected to/on at position " p)))))))
((tgt-raw (cond ((and (= (tp-type) "ident") (or (= (tp-val) "element") (= (tp-val) "global") (= (tp-val) "local"))) (do (adv!) (parse-expr))) (true (parse-expr)))))
(let
((tgt (if (= (tp-type) "attr") (let ((attr-name (get (adv!) "value"))) (list (quote attr) attr-name tgt-raw)) tgt-raw)))
(cond
((match-kw "to")
(let
((value (parse-expr)))
(list (quote set!) tgt value)))
((match-kw "on")
(let
((target (parse-expr)))
(if
(match-kw "to")
(let
((value (parse-expr)))
(list (quote set-on!) tgt target value))
(list (quote set-on) tgt target))))
(true (error (str "Expected to/on at position " p))))))))
(define
parse-put-cmd
(fn

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

@@ -294,10 +294,13 @@
hs-add-to!
(fn
(value target)
(if
(list? target)
(append target (list value))
(host-call target "push" value))))
(cond
((list? target)
(if
(some (fn (x) (= x value)) target)
target
(append target (list value))))
(true (do (host-call target "push" value) target)))))
;; First/last within a specific scope.
(define
@@ -664,7 +667,11 @@
(cond
((nil? target) value)
((string? target) (str target value))
((list? target) (append target (list value)))
((list? target)
(if
(some (fn (x) (= x value)) target)
target
(append target (list value))))
((hs-element? target)
(do
(dom-insert-adjacent-html target "beforeend" (str value))
@@ -688,6 +695,61 @@
((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-json-escape
(fn
(s)
(str
"\""
(let
((out "") (i 0) (n (string-length s)))
(define
walk
(fn
()
(when
(< i n)
(let
((c (substring s i (+ i 1))))
(set!
out
(cond
((= c "\\") (str out "\\\\"))
((= c "\"") (str out "\\\""))
((= c "\n") (str out "\\n"))
((= c "\r") (str out "\\r"))
((= c "\t") (str out "\\t"))
(true (str out c))))
(set! i (+ i 1))
(walk)))))
(walk)
out)
"\"")))
;; Collection: sorted by
(define
hs-json-stringify
(fn
(v)
(cond
((nil? v) "null")
((= v true) "true")
((= v false) "false")
((number? v) (str v))
((string? v) (hs-json-escape v))
((list? v) (str "[" (join "," (map hs-json-stringify v)) "]"))
((dict? v)
(str
"{"
(join
","
(map
(fn
(k)
(str (hs-json-escape k) ":" (hs-json-stringify (get v k))))
(keys v)))
"}"))
(true (hs-json-escape (str v))))))
;; Collection: sorted by descending
(define
hs-coerce
(fn
@@ -705,19 +767,39 @@
((= type-name "Bool") (not (hs-falsy? value)))
((= type-name "Boolean") (not (hs-falsy? value)))
((= type-name "Array") (if (list? value) value (list value)))
((= type-name "HTML") (str value))
((= type-name "HTML")
(cond
((list? value) (join "" (map (fn (x) (str x)) value)))
((hs-element? value) (host-get value "outerHTML"))
(true (str value))))
((= type-name "JSON")
(cond
((string? value) (guard (_e (true value)) (json-parse value)))
((dict? value) (json-stringify value))
((list? value) (json-stringify value))
((dict? value) (hs-json-stringify value))
((list? value) (hs-json-stringify value))
(true value)))
((= type-name "Object")
(if
(string? value)
(guard (_e (true value)) (json-parse value))
value))
((= type-name "JSONString") (json-stringify value))
((= type-name "JSONString") (hs-json-stringify value))
((= type-name "FormEncoded")
(if
(dict? value)
(join
"&"
(map
(fn
(k)
(let
((v (get value k)))
(if
(list? v)
(join "&" (map (fn (item) (str k "=" item)) v))
(str k "=" v))))
(keys value)))
(str value)))
((or (= type-name "Fixed") (= type-name "Fixed:") (starts-with? type-name "Fixed:"))
(let
((digits (if (> (string-length type-name) 6) (+ (substring type-name 6 (string-length type-name)) 0) 0))
@@ -774,7 +856,7 @@
(map (fn (k) (list k (get value k))) (keys value))
value))
(true value))))
;; Collection: sorted by
;; Collection: split by
(define
hs-gather-form-nodes
(fn
@@ -808,11 +890,11 @@
(each 0)))))))))
(walk root)
acc)))
;; Collection: sorted by descending
;; Collection: joined by
(define
hs-values-from-nodes
(fn (nodes) (reduce hs-values-absorb (dict) nodes)))
;; Collection: split by
(define
hs-value-of-node
(fn
@@ -828,7 +910,7 @@
((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