coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions 7 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

68
lib/hyperscript/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