Compare commits
8 Commits
hs-f
...
hs-e36-web
| Author | SHA1 | Date | |
|---|---|---|---|
| 8915eeaf5e | |||
| de493e41d8 | |||
| e4e784dba6 | |||
| e9ea1bf160 | |||
| ce39a35c6b | |||
| a20c9c4625 | |||
| c2dcc94ce2 | |||
| 6327c05ca6 |
File diff suppressed because it is too large
Load Diff
@@ -19,7 +19,6 @@
|
||||
(define
|
||||
reserved
|
||||
(list
|
||||
(quote beingTold)
|
||||
(quote me)
|
||||
(quote it)
|
||||
(quote event)
|
||||
@@ -66,10 +65,7 @@
|
||||
(list (quote me))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list (quote beingTold) (quote me))
|
||||
(list (quote it) nil)
|
||||
(list (quote event) nil))
|
||||
(list (list (quote it) nil) (list (quote event) nil))
|
||||
guarded))))))))))
|
||||
|
||||
;; ── Activate a single element ───────────────────────────────────
|
||||
@@ -77,51 +73,26 @@
|
||||
;; Marks the element to avoid double-activation.
|
||||
|
||||
(define
|
||||
hs-register-scripts!
|
||||
hs-activate!
|
||||
(fn
|
||||
()
|
||||
(for-each
|
||||
(fn
|
||||
(script)
|
||||
(el)
|
||||
(let
|
||||
((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script")))
|
||||
(when
|
||||
(and src (not (= src prev)))
|
||||
(when
|
||||
(not (dom-get-data script "hs-script-loaded"))
|
||||
(let
|
||||
((src (host-get script "innerHTML")))
|
||||
(when
|
||||
(and src (not (= src "")))
|
||||
(guard
|
||||
(_e (true nil))
|
||||
(eval-expr-cek (hs-to-sx-from-source src)))
|
||||
(dom-set-data script "hs-script-loaded" true)))))
|
||||
(hs-query-all "script[type=text/hyperscript]"))))
|
||||
(dom-dispatch el "hyperscript:before:init" nil)
|
||||
(hs-log-event! "hyperscript:init")
|
||||
(dom-set-data el "hs-script" src)
|
||||
(dom-set-data el "hs-active" true)
|
||||
(dom-set-attr el "data-hyperscript-powered" "true")
|
||||
(let ((handler (hs-handler src))) (handler el))
|
||||
(dom-dispatch el "hyperscript:after:init" nil))))))
|
||||
|
||||
;; ── Boot: scan entire document ──────────────────────────────────
|
||||
;; Called once at page load. Finds all elements with _ attribute,
|
||||
;; compiles their hyperscript, and activates them.
|
||||
|
||||
(define
|
||||
hs-activate!
|
||||
(fn
|
||||
(el)
|
||||
(do
|
||||
(hs-register-scripts!)
|
||||
(let
|
||||
((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script")))
|
||||
(when
|
||||
(and src (not (= src prev)))
|
||||
(when
|
||||
(dom-dispatch el "hyperscript:before:init" nil)
|
||||
(hs-log-event! "hyperscript:init")
|
||||
(dom-set-data el "hs-script" src)
|
||||
(dom-set-data el "hs-active" true)
|
||||
(dom-set-attr el "data-hyperscript-powered" "true")
|
||||
(let ((handler (hs-handler src))) (handler el))
|
||||
(dom-dispatch el "hyperscript:after:init" nil)))))))
|
||||
|
||||
;; ── Boot subtree: for dynamic content ───────────────────────────
|
||||
;; Called after HTMX swaps or dynamic DOM insertion.
|
||||
;; Only activates elements within the given root.
|
||||
|
||||
(define
|
||||
hs-deactivate!
|
||||
(fn
|
||||
@@ -133,6 +104,10 @@
|
||||
(dom-set-data el "hs-active" false)
|
||||
(dom-set-data el "hs-script" nil))))
|
||||
|
||||
;; ── Boot subtree: for dynamic content ───────────────────────────
|
||||
;; Called after HTMX swaps or dynamic DOM insertion.
|
||||
;; Only activates elements within the given root.
|
||||
|
||||
(define
|
||||
hs-boot!
|
||||
(fn
|
||||
|
||||
@@ -9,11 +9,7 @@
|
||||
(fn
|
||||
(tokens src)
|
||||
(let
|
||||
((tokens (filter (fn (t) (not (= (get t "type") "whitespace"))) tokens))
|
||||
(p 0)
|
||||
(tok-len
|
||||
(len
|
||||
(filter (fn (t) (not (= (get t "type") "whitespace"))) tokens))))
|
||||
((p 0) (tok-len (len tokens)))
|
||||
(define tp (fn () (if (< p tok-len) (nth tokens p) nil)))
|
||||
(define
|
||||
tp-type
|
||||
@@ -25,16 +21,6 @@
|
||||
adv!
|
||||
(fn () (let ((t (nth tokens p))) (set! p (+ p 1)) t)))
|
||||
(define at-end? (fn () (or (>= p tok-len) (= (tp-type) "eof"))))
|
||||
(define cur-start (fn () (if (< p tok-len) (get (tp) "pos") 0)))
|
||||
(define cur-line (fn () (if (< p tok-len) (get (tp) "line") 1)))
|
||||
(define
|
||||
prev-end
|
||||
(fn () (if (> p 0) (get (nth tokens (- p 1)) "end") 0)))
|
||||
(define
|
||||
hs-ast-wrap
|
||||
(fn
|
||||
(raw kind start end-pos line fields)
|
||||
(if hs-span-mode {:children raw :end end-pos :kind kind :line line :src src :start start :hs-ast true :fields fields} raw)))
|
||||
(define
|
||||
match-kw
|
||||
(fn
|
||||
@@ -83,40 +69,19 @@
|
||||
parse-prop-chain
|
||||
(fn
|
||||
(base)
|
||||
(let
|
||||
((base-start (if (and (dict? base) (get base :hs-ast)) (get base :start) (cur-start)))
|
||||
(base-line
|
||||
(if
|
||||
(and (dict? base) (get base :hs-ast))
|
||||
(get base :line)
|
||||
(cur-line))))
|
||||
(if
|
||||
(and (= (tp-type) "class") (not (at-end?)))
|
||||
(let
|
||||
((prop (tp-val)))
|
||||
(do
|
||||
(adv!)
|
||||
(parse-prop-chain (list (make-symbol ".") base prop))))
|
||||
(if
|
||||
(and (= (tp-type) "class") (not (at-end?)))
|
||||
(= (tp-type) "paren-open")
|
||||
(let
|
||||
((prop (tp-val)))
|
||||
(do
|
||||
(adv!)
|
||||
(parse-prop-chain
|
||||
(hs-ast-wrap
|
||||
(list (make-symbol ".") base prop)
|
||||
"member"
|
||||
base-start
|
||||
(prev-end)
|
||||
base-line
|
||||
{:root base}))))
|
||||
(if
|
||||
(= (tp-type) "paren-open")
|
||||
(let
|
||||
((args (parse-call-args)))
|
||||
(parse-prop-chain
|
||||
(hs-ast-wrap
|
||||
(list (quote method-call) base args)
|
||||
"call"
|
||||
base-start
|
||||
(prev-end)
|
||||
base-line
|
||||
{:root base})))
|
||||
base)))))
|
||||
((args (parse-call-args)))
|
||||
(parse-prop-chain (list (quote method-call) base args)))
|
||||
base))))
|
||||
(define
|
||||
parse-trav
|
||||
(fn
|
||||
@@ -127,23 +92,19 @@
|
||||
((and (= kind (quote closest)) (= typ "ident") (= val "parent"))
|
||||
(do (adv!) (parse-trav (quote closest-parent))))
|
||||
((= typ "selector")
|
||||
(do (adv!) (list kind val (list (quote beingTold)))))
|
||||
(do (adv!) (list kind val (list (quote me)))))
|
||||
((= typ "class")
|
||||
(do
|
||||
(adv!)
|
||||
(list kind (str "." val) (list (quote beingTold)))))
|
||||
(do (adv!) (list kind (str "." val) (list (quote me)))))
|
||||
((= typ "id")
|
||||
(do
|
||||
(adv!)
|
||||
(list kind (str "#" val) (list (quote beingTold)))))
|
||||
(do (adv!) (list kind (str "#" val) (list (quote me)))))
|
||||
((= typ "attr")
|
||||
(do
|
||||
(adv!)
|
||||
(list
|
||||
(quote attr)
|
||||
val
|
||||
(list kind (str "[" val "]") (list (quote beingTold))))))
|
||||
(true (list kind "*" (list (quote beingTold))))))))
|
||||
(list kind (str "[" val "]") (list (quote me))))))
|
||||
(true (list kind "*" (list (quote me))))))))
|
||||
(define
|
||||
parse-pos-kw
|
||||
(fn
|
||||
@@ -163,24 +124,8 @@
|
||||
(let
|
||||
((typ (tp-type)) (val (tp-val)))
|
||||
(cond
|
||||
((= typ "number")
|
||||
(let
|
||||
((s (cur-start)) (l (cur-line)))
|
||||
(do
|
||||
(adv!)
|
||||
(hs-ast-wrap
|
||||
(parse-dur val)
|
||||
"number"
|
||||
s
|
||||
(prev-end)
|
||||
l
|
||||
{}))))
|
||||
((= typ "string")
|
||||
(let
|
||||
((s (cur-start)) (l (cur-line)))
|
||||
(do
|
||||
(adv!)
|
||||
(hs-ast-wrap val "string" s (prev-end) l {}))))
|
||||
((= typ "number") (do (adv!) (parse-dur val)))
|
||||
((= typ "string") (do (adv!) val))
|
||||
((= typ "template") (do (adv!) (list (quote template) val)))
|
||||
((and (= typ "keyword") (= val "true")) (do (adv!) true))
|
||||
((and (= typ "keyword") (= val "false")) (do (adv!) false))
|
||||
@@ -245,51 +190,26 @@
|
||||
((and (= typ "keyword") (= val "last"))
|
||||
(do (adv!) (parse-pos-kw (quote last))))
|
||||
((= typ "id")
|
||||
(let
|
||||
((s (cur-start)) (l (cur-line)))
|
||||
(do
|
||||
(adv!)
|
||||
(hs-ast-wrap
|
||||
(list (quote query) (str "#" val))
|
||||
"selector"
|
||||
s
|
||||
(prev-end)
|
||||
l
|
||||
{}))))
|
||||
(do (adv!) (list (quote query) (str "#" val))))
|
||||
((= typ "selector")
|
||||
(let
|
||||
((s (cur-start)) (l (cur-line)))
|
||||
(do
|
||||
(adv!)
|
||||
(hs-ast-wrap
|
||||
(if
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "in"))
|
||||
(do
|
||||
(adv!)
|
||||
(list
|
||||
(quote query-scoped)
|
||||
val
|
||||
(parse-cmp
|
||||
(parse-arith (parse-poss (parse-atom))))))
|
||||
(list (quote query) val))
|
||||
"selector"
|
||||
s
|
||||
(prev-end)
|
||||
l
|
||||
{}))))
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "in"))
|
||||
(do
|
||||
(adv!)
|
||||
(list
|
||||
(quote query-scoped)
|
||||
val
|
||||
(parse-cmp (parse-arith (parse-poss (parse-atom))))))
|
||||
(list (quote query) val))))
|
||||
((= typ "attr")
|
||||
(do
|
||||
(adv!)
|
||||
(list (quote attr) val (list (quote beingTold)))))
|
||||
(do (adv!) (list (quote attr) val (list (quote me)))))
|
||||
((= typ "style")
|
||||
(do
|
||||
(adv!)
|
||||
(list (quote style) val (list (quote beingTold)))))
|
||||
(do (adv!) (list (quote style) val (list (quote me)))))
|
||||
((= typ "local") (do (adv!) (list (quote local) val)))
|
||||
((= typ "hat")
|
||||
(do
|
||||
(adv!)
|
||||
(list (quote dom-ref) val (list (quote beingTold)))))
|
||||
(do (adv!) (list (quote dom-ref) val (list (quote me)))))
|
||||
((and (= typ "keyword") (= val "dom"))
|
||||
(do
|
||||
(adv!)
|
||||
@@ -297,31 +217,10 @@
|
||||
((name (tp-val)))
|
||||
(do
|
||||
(adv!)
|
||||
(list (quote dom-ref) name (list (quote beingTold)))))))
|
||||
(list (quote dom-ref) name (list (quote me)))))))
|
||||
((= typ "class")
|
||||
(let
|
||||
((s (cur-start)) (l (cur-line)))
|
||||
(do
|
||||
(adv!)
|
||||
(hs-ast-wrap
|
||||
(list (quote query) (str "." val))
|
||||
"selector"
|
||||
s
|
||||
(prev-end)
|
||||
l
|
||||
{}))))
|
||||
((= typ "ident")
|
||||
(let
|
||||
((s (cur-start)) (l (cur-line)))
|
||||
(do
|
||||
(adv!)
|
||||
(hs-ast-wrap
|
||||
(list (quote ref) val)
|
||||
"ref"
|
||||
s
|
||||
(prev-end)
|
||||
l
|
||||
{}))))
|
||||
(do (adv!) (list (quote query) (str "." val))))
|
||||
((= typ "ident") (do (adv!) (list (quote ref) val)))
|
||||
((= typ "paren-open")
|
||||
(do
|
||||
(adv!)
|
||||
@@ -429,8 +328,6 @@
|
||||
(let
|
||||
((name val) (args (parse-call-args)))
|
||||
(cons (quote call) (cons (list (quote ref) name) args)))))
|
||||
((= typ "keyword")
|
||||
(do (adv!) (list (quote ref) val)))
|
||||
(true nil)))))
|
||||
(define
|
||||
parse-poss
|
||||
@@ -440,14 +337,6 @@
|
||||
((and (= (tp-type) "op") (= (tp-val) "'s"))
|
||||
(do (adv!) (parse-poss-tail obj)))
|
||||
((= (tp-type) "class") (parse-prop-chain obj))
|
||||
((= (tp-type) "dot")
|
||||
(do
|
||||
(adv!)
|
||||
(let ((typ2 (tp-type)) (val2 (tp-val)))
|
||||
(if
|
||||
(or (= typ2 "ident") (= typ2 "keyword"))
|
||||
(do (adv!) (parse-poss (list (make-symbol ".") obj val2)))
|
||||
obj))))
|
||||
((= (tp-type) "paren-open")
|
||||
(let
|
||||
((args (parse-call-args)))
|
||||
@@ -574,9 +463,7 @@
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote eq-ignore-case) left right)))
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote hs-id=) left right)))))))
|
||||
(list (quote not) (list (quote =) left right)))))))
|
||||
((match-kw "empty") (list (quote empty?) left))
|
||||
((match-kw "less")
|
||||
(do
|
||||
@@ -1006,7 +893,7 @@
|
||||
(collect-classes!))))
|
||||
(collect-classes!)
|
||||
(let
|
||||
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold)))))
|
||||
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
|
||||
(let
|
||||
((when-clause (if (match-kw "when") (parse-expr) nil)))
|
||||
(if
|
||||
@@ -1035,7 +922,7 @@
|
||||
(get (adv!) "value")
|
||||
(parse-expr))))
|
||||
(let
|
||||
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold)))))
|
||||
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
|
||||
(list (quote set-style) prop value tgt))))
|
||||
((= (tp-type) "brace-open")
|
||||
(do
|
||||
@@ -1054,16 +941,14 @@
|
||||
((prop (get (adv!) "value")))
|
||||
(when (= (tp-type) "colon") (adv!))
|
||||
(let
|
||||
((val (if (and (= (tp-type) "ident") (= (tp-val) "$")) (do (adv!) (when (= (tp-type) "brace-open") (adv!)) (if (= (tp-type) "brace-close") (do (adv!) (if (= (tp-type) "brace-open") (do (adv!) (let ((inner (parse-expr))) (when (= (tp-type) "brace-close") (adv!)) inner)) "")) (let ((expr (parse-expr))) (when (= (tp-type) "brace-close") (adv!)) expr))) (get (adv!) "value"))))
|
||||
((val (tp-val)))
|
||||
(adv!)
|
||||
(set! pairs (cons (list prop val) pairs))
|
||||
(when
|
||||
(and (= (tp-type) "op") (= (tp-val) ";"))
|
||||
(adv!))
|
||||
(collect-pairs!))))))
|
||||
(collect-pairs!)
|
||||
(when (= (tp-type) "brace-close") (adv!))
|
||||
(let
|
||||
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold)))))
|
||||
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
|
||||
(list (quote set-styles) (reverse pairs) tgt)))))
|
||||
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
|
||||
(do
|
||||
@@ -1075,7 +960,7 @@
|
||||
((attr-val (parse-expr)))
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "to" (list (quote beingTold)))))
|
||||
((tgt (parse-tgt-kw "to" (list (quote me)))))
|
||||
(let
|
||||
((when-clause (if (match-kw "when") (parse-expr) nil)))
|
||||
(if
|
||||
@@ -1093,7 +978,7 @@
|
||||
(let
|
||||
((attr-val (if (and (= (tp-type) "op") (= (tp-val) "=")) (do (adv!) (parse-expr)) "")))
|
||||
(let
|
||||
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold)))))
|
||||
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
|
||||
(let
|
||||
((when-clause (if (match-kw "when") (parse-expr) nil)))
|
||||
(if
|
||||
@@ -1134,23 +1019,18 @@
|
||||
(collect-classes!))))
|
||||
(collect-classes!)
|
||||
(let
|
||||
((tgt (if (match-kw "from") (parse-expr) (list (quote beingTold)))))
|
||||
(let
|
||||
((when-clause (if (match-kw "when") (parse-expr) nil)))
|
||||
(if
|
||||
(empty? extra-classes)
|
||||
(if
|
||||
when-clause
|
||||
(list (quote remove-class-when) cls tgt when-clause)
|
||||
(list (quote remove-class) cls tgt))
|
||||
(cons
|
||||
(quote multi-remove-class)
|
||||
(cons tgt (cons cls extra-classes))))))))
|
||||
((tgt (if (match-kw "from") (parse-expr) (list (quote me)))))
|
||||
(if
|
||||
(empty? extra-classes)
|
||||
(list (quote remove-class) cls tgt)
|
||||
(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 beingTold)))))
|
||||
((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
|
||||
@@ -1212,7 +1092,7 @@
|
||||
(let
|
||||
((cls2 (do (let ((v (tp-val))) (adv!) v))))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote beingTold)))))
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(list (quote toggle-between) cls1 cls2 tgt)))
|
||||
nil)))
|
||||
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
|
||||
@@ -1237,7 +1117,7 @@
|
||||
((v2 (parse-expr)))
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote beingTold)))))
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(if
|
||||
(= n1 n2)
|
||||
(list
|
||||
@@ -1271,7 +1151,7 @@
|
||||
(let
|
||||
((extra-classes (collect-classes (list))))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote beingTold)))))
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(cond
|
||||
((> (len extra-classes) 0)
|
||||
(list
|
||||
@@ -1300,7 +1180,7 @@
|
||||
(let
|
||||
((prop (get (adv!) "value")))
|
||||
(let
|
||||
((tgt (if (match-kw "of") (parse-expr) (list (quote beingTold)))))
|
||||
((tgt (if (match-kw "of") (parse-expr) (list (quote me)))))
|
||||
(if
|
||||
(match-kw "between")
|
||||
(let
|
||||
@@ -1371,7 +1251,7 @@
|
||||
(let
|
||||
((attr-name (get (adv!) "value")))
|
||||
(let
|
||||
((tgt (if (match-kw "on") (parse-expr) (list (quote beingTold)))))
|
||||
((tgt (if (match-kw "on") (parse-expr) (list (quote me)))))
|
||||
(if
|
||||
(match-kw "between")
|
||||
(let
|
||||
@@ -1396,7 +1276,7 @@
|
||||
((attr-val (parse-expr)))
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote beingTold)))))
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(list (quote toggle-attr-val) attr-name attr-val tgt))))))
|
||||
((and (= (tp-type) "keyword") (= (tp-val) "my"))
|
||||
(do
|
||||
@@ -1475,9 +1355,7 @@
|
||||
((match-kw "to")
|
||||
(let
|
||||
((value (parse-expr)))
|
||||
(if (and (list? tgt) (= (first tgt) (quote query)))
|
||||
(list (quote set-el!) tgt value)
|
||||
(list (quote set!) tgt value))))
|
||||
(list (quote set!) tgt value)))
|
||||
((match-kw "on")
|
||||
(let
|
||||
((target (parse-expr)))
|
||||
@@ -1626,7 +1504,7 @@
|
||||
(let
|
||||
((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil)))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "to" (list (quote beingTold)))))
|
||||
((tgt (parse-tgt-kw "to" (list (quote me)))))
|
||||
(if
|
||||
dtl
|
||||
(list (quote send) name dtl tgt)
|
||||
@@ -1640,7 +1518,7 @@
|
||||
(let
|
||||
((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil)))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote beingTold)))))
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(if
|
||||
dtl
|
||||
(list (quote trigger) name dtl tgt)
|
||||
@@ -1679,7 +1557,7 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show") (= (tp-val) "on"))) (list (quote beingTold))) (true (parse-expr)))))
|
||||
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show") (= (tp-val) "on"))) (list (quote me))) (true (parse-expr)))))
|
||||
(let
|
||||
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display")))
|
||||
(let
|
||||
@@ -1690,7 +1568,7 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show") (= (tp-val) "on"))) (list (quote beingTold))) (true (parse-expr)))))
|
||||
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show") (= (tp-val) "on"))) (list (quote me))) (true (parse-expr)))))
|
||||
(let
|
||||
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display")))
|
||||
(let
|
||||
@@ -1716,7 +1594,7 @@
|
||||
((from-val (if (match-kw "from") (let ((v (parse-atom))) (if (and v (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v)) nil)))
|
||||
(expect-kw! "to")
|
||||
(let
|
||||
((value (if (and (= (tp-type) "ident") (= (tp-val) "initial")) (do (adv!) "initial") (let ((v (parse-atom))) (if (and v (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v)))))
|
||||
((value (let ((v (parse-atom))) (if (and v (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v))))
|
||||
(let
|
||||
((dur (if (match-kw "over") (let ((v (parse-atom))) (if (and (number? v) (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v)) nil)))
|
||||
(let
|
||||
@@ -1806,7 +1684,7 @@
|
||||
((url (if (and (= (tp-type) "keyword") (= (tp-val) "from")) (do (adv!) (parse-arith (parse-poss (parse-atom)))) nil)))
|
||||
(list (quote fetch-gql) gql-source url))))
|
||||
(let
|
||||
((url-atom (if (and (= (tp-type) "op") (= (tp-val) "/")) (do (adv!) (let ((path-parts (list "/"))) (define read-path (fn () (when (and (not (at-end?)) (or (and (= (tp-type) "ident") (not (string-contains? (tp-val) "'"))) (= (tp-type) "op") (= (tp-type) "dot") (= (tp-type) "number"))) (append! path-parts (tp-val)) (adv!) (read-path)))) (read-path) (join "" path-parts))) (parse-atom))))
|
||||
((url-atom (if (and (= (tp-type) "op") (= (tp-val) "/")) (do (adv!) (let ((path-parts (list "/"))) (define read-path (fn () (when (and (not (at-end?)) (or (= (tp-type) "ident") (= (tp-type) "op") (= (tp-type) "dot") (= (tp-type) "number"))) (append! path-parts (tp-val)) (adv!) (read-path)))) (read-path) (join "" path-parts))) (parse-atom))))
|
||||
(let
|
||||
((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom)))))
|
||||
(let
|
||||
@@ -1822,9 +1700,7 @@
|
||||
((fmt-after (if (and (not fmt-before) (match-kw "as")) (do (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (or (= (tp-val) "an") (= (tp-val) "a"))) (adv!)) (let ((f (tp-val))) (adv!) f)) nil)))
|
||||
(let
|
||||
((fmt (or fmt-before fmt-after "text")))
|
||||
(let
|
||||
((do-not-throw (cond ((and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "do")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "not")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw")) (do (adv!) true) false)) false))) ((and (= (tp-type) "ident") (= (tp-val) "don't")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw")) (do (adv!) true) false))) (true false))))
|
||||
(list (quote fetch) url fmt do-not-throw))))))))))
|
||||
(list (quote fetch) url fmt)))))))))
|
||||
(define
|
||||
parse-call-args
|
||||
(fn
|
||||
@@ -2145,21 +2021,7 @@
|
||||
((op (cond ((= val "+") (quote +)) ((= val "-") (quote -)) ((= val "*") (quote *)) ((= val "/") (quote /)) ((or (= val "%") (= val "mod")) (make-symbol "%")))))
|
||||
(let
|
||||
((right (let ((a (parse-atom))) (if (nil? a) a (parse-poss a)))))
|
||||
(let
|
||||
((lhs-start (if (and (dict? left) (get left :hs-ast)) (get left :start) 0))
|
||||
(lhs-line
|
||||
(if
|
||||
(and (dict? left) (get left :hs-ast))
|
||||
(get left :line)
|
||||
1)))
|
||||
(parse-arith
|
||||
(hs-ast-wrap
|
||||
(list op left right)
|
||||
"arith"
|
||||
lhs-start
|
||||
(prev-end)
|
||||
lhs-line
|
||||
{:rhs right :lhs left}))))))
|
||||
(parse-arith (list op left right)))))
|
||||
left))))
|
||||
(define
|
||||
parse-the-expr
|
||||
@@ -2174,21 +2036,21 @@
|
||||
(if
|
||||
(match-kw "of")
|
||||
(list (quote style) val (parse-expr))
|
||||
(list (quote style) val (list (quote beingTold))))))
|
||||
(list (quote style) val (list (quote me))))))
|
||||
((= typ "attr")
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(match-kw "of")
|
||||
(list (quote attr) val (parse-expr))
|
||||
(list (quote attr) val (list (quote beingTold))))))
|
||||
(list (quote attr) val (list (quote me))))))
|
||||
((= typ "class")
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(match-kw "of")
|
||||
(list (quote has-class?) (parse-expr) val)
|
||||
(list (quote has-class?) (list (quote beingTold)) val))))
|
||||
(list (quote has-class?) (list (quote me)) val))))
|
||||
((= typ "selector")
|
||||
(do
|
||||
(adv!)
|
||||
@@ -2336,15 +2198,13 @@
|
||||
()
|
||||
(let
|
||||
((tgt (parse-expr)))
|
||||
(list
|
||||
(quote measure)
|
||||
(if (nil? tgt) (list (quote beingTold)) tgt)))))
|
||||
(list (quote measure) (if (nil? tgt) (list (quote me)) tgt)))))
|
||||
(define
|
||||
parse-scroll-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote beingTold)) (parse-expr))))
|
||||
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote me)) (parse-expr))))
|
||||
(let
|
||||
((pos (cond ((match-kw "top") "top") ((match-kw "bottom") "bottom") ((match-kw "left") "left") ((match-kw "right") "right") (true "top"))))
|
||||
(list (quote scroll!) tgt pos)))))
|
||||
@@ -2353,14 +2213,14 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote beingTold)) (parse-expr))))
|
||||
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote me)) (parse-expr))))
|
||||
(list (quote select!) tgt))))
|
||||
(define
|
||||
parse-reset-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote beingTold)) (parse-expr))))
|
||||
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote me)) (parse-expr))))
|
||||
(list (quote reset!) tgt))))
|
||||
(define
|
||||
parse-default-cmd
|
||||
@@ -2385,7 +2245,7 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr)))))
|
||||
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
|
||||
(list (quote focus!) tgt))))
|
||||
(define
|
||||
parse-feat-body
|
||||
@@ -2499,7 +2359,7 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((target (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr)))))
|
||||
((target (cond ((at-end?) (list (quote ref) "me")) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote ref) "me")) (true (parse-expr)))))
|
||||
(list (quote empty-target) target))))
|
||||
(define
|
||||
parse-swap-cmd
|
||||
@@ -2524,42 +2384,15 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((target (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr)))))
|
||||
((target (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
|
||||
(list (quote open-element) target))))
|
||||
(define
|
||||
parse-close-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((target (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr)))))
|
||||
((target (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
|
||||
(list (quote close-element) target))))
|
||||
(define
|
||||
parse-js-block
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((params (if (= (tp-type) "paren-open") (do (adv!) (define collect-params! (fn (acc) (cond ((or (at-end?) (= (tp-type) "paren-close")) (do (when (= (tp-type) "paren-close") (adv!)) acc)) ((= (tp-type) "comma") (do (adv!) (collect-params! acc))) (true (let ((pname (tp-val))) (do (adv!) (collect-params! (append acc pname)))))))) (collect-params! (list))) (list))))
|
||||
(let
|
||||
((js-start (cur-start)))
|
||||
(define
|
||||
skip-to-end!
|
||||
(fn
|
||||
()
|
||||
(if
|
||||
(or
|
||||
(at-end?)
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "end")))
|
||||
nil
|
||||
(do (adv!) (skip-to-end!)))))
|
||||
(skip-to-end!)
|
||||
(let
|
||||
((js-end (cur-start)))
|
||||
(let
|
||||
((js-src (substring src js-start js-end)))
|
||||
(when
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "end"))
|
||||
(adv!))
|
||||
(list (quote js-block) params js-src)))))))
|
||||
(define
|
||||
parse-cmd
|
||||
(fn
|
||||
@@ -2588,21 +2421,7 @@
|
||||
((and (= typ "keyword") (= val "put"))
|
||||
(do (adv!) (parse-put-cmd)))
|
||||
((and (= typ "keyword") (= val "if"))
|
||||
(let
|
||||
((s (cur-start)) (l (cur-line)))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((r (parse-if-cmd)))
|
||||
(let
|
||||
((tb (if (and (list? r) (> (len r) 2)) (nth r 2) nil)))
|
||||
(hs-ast-wrap
|
||||
r
|
||||
"if"
|
||||
s
|
||||
(prev-end)
|
||||
l
|
||||
(if tb {:true-branch (if (and (list? tb) (= (first tb) (quote do))) (nth tb 1) tb)} {})))))))
|
||||
(do (adv!) (parse-if-cmd)))
|
||||
((and (= typ "keyword") (= val "wait"))
|
||||
(do (adv!) (parse-wait-cmd)))
|
||||
((and (= typ "keyword") (= val "send"))
|
||||
@@ -2610,17 +2429,7 @@
|
||||
((and (= typ "keyword") (= val "trigger"))
|
||||
(do (adv!) (parse-trigger-cmd)))
|
||||
((and (= typ "keyword") (= val "log"))
|
||||
(let
|
||||
((s (cur-start)) (l (cur-line)))
|
||||
(do
|
||||
(adv!)
|
||||
(hs-ast-wrap
|
||||
(parse-log-cmd)
|
||||
"cmd"
|
||||
s
|
||||
(prev-end)
|
||||
l
|
||||
{}))))
|
||||
(do (adv!) (parse-log-cmd)))
|
||||
((and (= typ "keyword") (= val "increment"))
|
||||
(do (adv!) (parse-inc-cmd)))
|
||||
((and (= typ "keyword") (= val "decrement"))
|
||||
@@ -2660,17 +2469,7 @@
|
||||
((and (= typ "keyword") (= val "tell"))
|
||||
(do (adv!) (parse-tell-cmd)))
|
||||
((and (= typ "keyword") (= val "for"))
|
||||
(let
|
||||
((s (cur-start)) (l (cur-line)))
|
||||
(do
|
||||
(adv!)
|
||||
(hs-ast-wrap
|
||||
(parse-for-cmd)
|
||||
"cmd"
|
||||
s
|
||||
(prev-end)
|
||||
l
|
||||
{}))))
|
||||
(do (adv!) (parse-for-cmd)))
|
||||
((and (= typ "keyword") (= val "make"))
|
||||
(do (adv!) (parse-make-cmd)))
|
||||
((and (= typ "keyword") (= val "install"))
|
||||
@@ -2709,18 +2508,6 @@
|
||||
(do (adv!) (list (quote continue))))
|
||||
((and (= typ "keyword") (or (= val "exit") (= val "halt")))
|
||||
(do (adv!) (list (quote exit))))
|
||||
((and (= typ "keyword") (= val "js"))
|
||||
(do (adv!) (parse-js-block)))
|
||||
((and (= typ "keyword") (= val "start"))
|
||||
(do
|
||||
(adv!)
|
||||
(expect-kw! "view")
|
||||
(expect-kw! "transition")
|
||||
(let ((using (if (match-kw "using") (parse-expr) nil)))
|
||||
(match-kw "then")
|
||||
(let ((body (parse-cmd-list)))
|
||||
(match-kw "end")
|
||||
(list (quote view-transition!) using body)))))
|
||||
(true (parse-expr))))))
|
||||
(define
|
||||
parse-cmd-list
|
||||
@@ -2776,71 +2563,41 @@
|
||||
(= v "close")
|
||||
(= v "pick")
|
||||
(= v "ask")
|
||||
(= v "answer")
|
||||
(= v "js")
|
||||
(= v "start"))))
|
||||
(= v "answer"))))
|
||||
(define
|
||||
cl-collect
|
||||
(fn
|
||||
(acc)
|
||||
(do
|
||||
(when
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "then"))
|
||||
(adv!))
|
||||
(let
|
||||
((cmd (parse-cmd)))
|
||||
(if
|
||||
(nil? cmd)
|
||||
acc
|
||||
(let
|
||||
((acc2 (append acc (list cmd))))
|
||||
(cond
|
||||
((match-kw "unless")
|
||||
(let
|
||||
((cnd (parse-expr)))
|
||||
(cl-collect
|
||||
(append
|
||||
acc
|
||||
(list
|
||||
(list
|
||||
(quote if)
|
||||
(list (quote no) cnd)
|
||||
cmd))))))
|
||||
((match-kw "then")
|
||||
(cl-collect (append acc2 (list (quote __then__)))))
|
||||
((or (and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val))) (= (tp-type) "paren-open"))
|
||||
(cl-collect acc2))
|
||||
(true acc2))))))))
|
||||
(let
|
||||
((cmd (parse-cmd)))
|
||||
(if
|
||||
(nil? cmd)
|
||||
acc
|
||||
(let
|
||||
((acc2 (append acc (list cmd))))
|
||||
(cond
|
||||
((match-kw "unless")
|
||||
(let
|
||||
((cnd (parse-expr)))
|
||||
(cl-collect
|
||||
(append
|
||||
acc
|
||||
(list
|
||||
(list (quote if) (list (quote no) cnd) cmd))))))
|
||||
((match-kw "then")
|
||||
(cl-collect (append acc2 (list (quote __then__)))))
|
||||
((or (and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val))) (= (tp-type) "paren-open"))
|
||||
(cl-collect acc2))
|
||||
(true acc2)))))))
|
||||
(let
|
||||
((cmds (cl-collect (list))))
|
||||
(define
|
||||
link-next-cmds
|
||||
(fn
|
||||
(cmds-list)
|
||||
(define
|
||||
loop
|
||||
(fn
|
||||
(i)
|
||||
(when
|
||||
(< i (- (len cmds-list) 1))
|
||||
(let
|
||||
((cur-node (nth cmds-list i))
|
||||
(nxt-node (nth cmds-list (+ i 1))))
|
||||
(when
|
||||
(and (dict? cur-node) (get cur-node :hs-ast))
|
||||
(dict-set! (get cur-node :fields) "next" nxt-node)))
|
||||
(loop (+ i 1)))))
|
||||
(loop 0)
|
||||
cmds-list))
|
||||
(let
|
||||
((linked (if hs-span-mode (link-next-cmds cmds) cmds)))
|
||||
(cond
|
||||
((= (len linked) 0) nil)
|
||||
((= (len linked) 1) (first linked))
|
||||
(true
|
||||
(cons
|
||||
(quote do)
|
||||
(filter (fn (c) (not (= c (quote __then__)))) linked))))))))
|
||||
(cond
|
||||
((= (len cmds) 0) nil)
|
||||
((= (len cmds) 1) (first cmds))
|
||||
(true
|
||||
(cons
|
||||
(quote do)
|
||||
(filter (fn (c) (not (= c (quote __then__)))) cmds)))))))
|
||||
(define
|
||||
parse-on-feat
|
||||
(fn
|
||||
@@ -2882,7 +2639,6 @@
|
||||
(true nil))))
|
||||
(true nil))))
|
||||
(consume-having!)
|
||||
(when (and (= (tp-type) "keyword") (= (tp-val) "queue")) (do (adv!) (adv!)))
|
||||
(let
|
||||
((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
|
||||
(let
|
||||
@@ -2973,6 +2729,63 @@
|
||||
(match-kw "end")
|
||||
(list (quote when-feat-no-op)))))
|
||||
(do (pwf-skip) (match-kw "end") (list (quote when-feat-no-op))))))
|
||||
(define
|
||||
parse-socket-feat
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((seg0 (tp-val)))
|
||||
(adv!)
|
||||
(define
|
||||
collect-segs
|
||||
(fn
|
||||
(acc)
|
||||
(if
|
||||
(= (tp-type) "class")
|
||||
(let
|
||||
((seg (tp-val)))
|
||||
(adv!)
|
||||
(collect-segs (append acc (list seg))))
|
||||
acc)))
|
||||
(let
|
||||
((name-path (collect-segs (list seg0))))
|
||||
(define
|
||||
url-cont?
|
||||
(fn
|
||||
()
|
||||
(or
|
||||
(= (tp-type) "ident")
|
||||
(= (tp-type) "number")
|
||||
(= (tp-type) "op")
|
||||
(= (tp-type) "colon")
|
||||
(= (tp-type) "dot")
|
||||
(and
|
||||
(= (tp-type) "keyword")
|
||||
(not
|
||||
(or
|
||||
(= (tp-val) "end")
|
||||
(= (tp-val) "with")
|
||||
(= (tp-val) "on")
|
||||
(= (tp-val) "as")))))))
|
||||
(define
|
||||
collect-url
|
||||
(fn
|
||||
(parts)
|
||||
(if
|
||||
(and (not (at-end?)) (url-cont?))
|
||||
(let
|
||||
((v (tp-val)))
|
||||
(adv!)
|
||||
(collect-url (append parts (list v))))
|
||||
(join "" parts))))
|
||||
(let
|
||||
((url (cond ((and (= (tp-type) "op") (= (tp-val) "/")) (do (adv!) (collect-url (list "/")))) ((= (tp-type) "ident") (let ((scheme (tp-val))) (adv!) (if (= (tp-type) "colon") (collect-url (list scheme)) (parse-arith (parse-poss (list (quote ref) scheme)))))) (true (parse-atom)))))
|
||||
(let
|
||||
((timeout-ms (if (match-kw "with") (do (adv!) (parse-expr)) nil)))
|
||||
(let
|
||||
((on-msg (if (match-kw "on") (do (adv!) (let ((json? (if (match-kw "as") (do (adv!) true) false))) (let ((body (parse-cmd-list))) (list (quote on-message) json? body)))) nil)))
|
||||
(match-kw "end")
|
||||
(list (quote socket) name-path url timeout-ms on-msg))))))))
|
||||
(define
|
||||
parse-feat
|
||||
(fn
|
||||
@@ -2993,9 +2806,7 @@
|
||||
((= val "behavior") (do (adv!) (parse-behavior-feat)))
|
||||
((= val "live") (do (adv!) (parse-live-feat)))
|
||||
((= val "when") (do (adv!) (parse-when-feat)))
|
||||
((= val "worker")
|
||||
(error
|
||||
"worker plugin is not installed — see https://hyperscript.org/features/worker"))
|
||||
((= val "socket") (do (adv!) (parse-socket-feat)))
|
||||
(true (parse-cmd-list))))))
|
||||
(define
|
||||
coll-feats
|
||||
@@ -3014,13 +2825,4 @@
|
||||
(first features)
|
||||
(cons (quote do) features))))))
|
||||
|
||||
(define hs-span-mode false)
|
||||
|
||||
(define hs-compile (fn (src) (hs-parse (hs-tokenize src) src)))
|
||||
|
||||
(define hs-parse-ast
|
||||
(fn (src)
|
||||
(do
|
||||
(set! hs-span-mode true)
|
||||
(let ((result (hs-parse (hs-tokenize src) src)))
|
||||
(do (set! hs-span-mode false) result)))))
|
||||
|
||||
@@ -43,47 +43,29 @@
|
||||
|
||||
;; Run an initializer function immediately.
|
||||
;; (hs-init thunk) — called at element boot time
|
||||
(define meta (host-new "Object"))
|
||||
(define
|
||||
hs-on
|
||||
(fn
|
||||
(target event-name handler)
|
||||
(let
|
||||
((wrapped (fn (event) (guard (e ((and (not (= event-name "exception")) (not (= event-name "error"))) (dom-dispatch target "exception" {:error e})) (true (raise e))) (handler event)))))
|
||||
(let
|
||||
((unlisten (dom-listen target event-name wrapped))
|
||||
(prev (or (dom-get-data target "hs-unlisteners") (list))))
|
||||
(dom-set-data target "hs-unlisteners" (append prev (list unlisten)))
|
||||
unlisten))))
|
||||
|
||||
;; ── Async / timing ──────────────────────────────────────────────
|
||||
|
||||
;; Wait for a duration in milliseconds.
|
||||
;; In hyperscript, wait is async-transparent — execution pauses.
|
||||
;; Here we use perform/IO suspension for true pause semantics.
|
||||
(define
|
||||
_hs-on-caller
|
||||
(let
|
||||
((_ctx (host-new "Object"))
|
||||
(_m (host-new "Object"))
|
||||
(_f (host-new "Object")))
|
||||
(do
|
||||
(host-set! _f "type" "onFeature")
|
||||
(host-set! _m "feature" _f)
|
||||
(host-set! _ctx "meta" _m)
|
||||
_ctx)))
|
||||
|
||||
;; Wait for a DOM event on a target.
|
||||
;; (hs-wait-for target event-name) — suspends until event fires
|
||||
(define
|
||||
hs-on
|
||||
(fn
|
||||
(target event-name handler)
|
||||
(let
|
||||
((wrapped (fn (event) (do (host-set! meta "caller" _hs-on-caller) (host-set! meta "owner" target) (let ((__hs-no-stop false)) (guard (e ((and (not (= event-name "exception")) (not (= event-name "error"))) (do (when (and (list? e) (= (first e) "hs-halt-default")) (set! __hs-no-stop true)) (when (not __hs-no-stop) (dom-dispatch target "exception" {:error e})))) (true (raise e))) (handler event)) (when (not __hs-no-stop) (host-call event "stopPropagation")))))))
|
||||
(let
|
||||
((unlisten (dom-listen target event-name wrapped))
|
||||
(prev (or (dom-get-data target "hs-unlisteners") (list))))
|
||||
(dom-set-data target "hs-unlisteners" (append prev (list unlisten)))
|
||||
unlisten))))
|
||||
|
||||
;; Wait for CSS transitions/animations to settle on an element.
|
||||
(define
|
||||
hs-on-every
|
||||
(fn (target event-name handler) (dom-listen target event-name handler)))
|
||||
|
||||
;; ── Class manipulation ──────────────────────────────────────────
|
||||
|
||||
;; Toggle a single class on an element.
|
||||
;; Wait for a DOM event on a target.
|
||||
;; (hs-wait-for target event-name) — suspends until event fires
|
||||
(define
|
||||
hs-on-intersection-attach!
|
||||
(fn
|
||||
@@ -99,7 +81,7 @@
|
||||
(host-call observer "observe" target)
|
||||
observer)))))
|
||||
|
||||
;; Toggle between two classes — exactly one is active at a time.
|
||||
;; Wait for CSS transitions/animations to settle on an element.
|
||||
(define
|
||||
hs-on-mutation-attach!
|
||||
(fn
|
||||
@@ -120,19 +102,16 @@
|
||||
(host-call observer "observe" target opts)
|
||||
observer))))))
|
||||
|
||||
;; Take a class from siblings — add to target, remove from others.
|
||||
;; (hs-take! target cls) — like radio button class behavior
|
||||
;; ── Class manipulation ──────────────────────────────────────────
|
||||
|
||||
;; Toggle a single class on an element.
|
||||
(define hs-init (fn (thunk) (thunk)))
|
||||
|
||||
;; ── DOM insertion ───────────────────────────────────────────────
|
||||
|
||||
;; Put content at a position relative to a target.
|
||||
;; pos: "into" | "before" | "after"
|
||||
;; Toggle between two classes — exactly one is active at a time.
|
||||
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
|
||||
|
||||
;; ── Navigation / traversal ──────────────────────────────────────
|
||||
|
||||
;; Navigate to a URL.
|
||||
;; Take a class from siblings — add to target, remove from others.
|
||||
;; (hs-take! target cls) — like radio button class behavior
|
||||
(begin
|
||||
(define
|
||||
hs-wait-for
|
||||
@@ -145,15 +124,20 @@
|
||||
(target event-name timeout-ms)
|
||||
(perform (list (quote io-wait-event) target event-name timeout-ms)))))
|
||||
|
||||
;; Find next sibling matching a selector (or any sibling).
|
||||
;; ── DOM insertion ───────────────────────────────────────────────
|
||||
|
||||
;; Put content at a position relative to a target.
|
||||
;; pos: "into" | "before" | "after"
|
||||
(define hs-settle (fn (target) (perform (list (quote io-settle) target))))
|
||||
|
||||
;; Find previous sibling matching a selector.
|
||||
;; ── Navigation / traversal ──────────────────────────────────────
|
||||
|
||||
;; Navigate to a URL.
|
||||
(define
|
||||
hs-toggle-class!
|
||||
(fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
|
||||
|
||||
;; First element matching selector within a scope.
|
||||
;; Find next sibling matching a selector (or any sibling).
|
||||
(define
|
||||
hs-toggle-between!
|
||||
(fn
|
||||
@@ -163,7 +147,7 @@
|
||||
(do (dom-remove-class target cls1) (dom-add-class target cls2))
|
||||
(do (dom-remove-class target cls2) (dom-add-class target cls1)))))
|
||||
|
||||
;; Last element matching selector.
|
||||
;; Find previous sibling matching a selector.
|
||||
(define
|
||||
hs-toggle-style!
|
||||
(fn
|
||||
@@ -187,7 +171,7 @@
|
||||
(dom-set-style target prop "hidden")
|
||||
(dom-set-style target prop "")))))))
|
||||
|
||||
;; First/last within a specific scope.
|
||||
;; First element matching selector within a scope.
|
||||
(define
|
||||
hs-toggle-style-between!
|
||||
(fn
|
||||
@@ -199,6 +183,7 @@
|
||||
(dom-set-style target prop val2)
|
||||
(dom-set-style target prop val1)))))
|
||||
|
||||
;; Last element matching selector.
|
||||
(define
|
||||
hs-toggle-style-cycle!
|
||||
(fn
|
||||
@@ -219,9 +204,7 @@
|
||||
(true (find-next (rest remaining))))))
|
||||
(dom-set-style target prop (find-next vals)))))
|
||||
|
||||
;; ── Iteration ───────────────────────────────────────────────────
|
||||
|
||||
;; Repeat a thunk N times.
|
||||
;; First/last within a specific scope.
|
||||
(define
|
||||
hs-take!
|
||||
(fn
|
||||
@@ -261,7 +244,6 @@
|
||||
(dom-set-attr target name attr-val)
|
||||
(dom-set-attr target name ""))))))))
|
||||
|
||||
;; Repeat forever (until break — relies on exception/continuation).
|
||||
(begin
|
||||
(define
|
||||
hs-element?
|
||||
@@ -311,26 +293,7 @@
|
||||
hs-set-inner-html!
|
||||
(fn
|
||||
(target value)
|
||||
(let
|
||||
((str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) value)))
|
||||
(do (dom-set-inner-html target str-val) (hs-boot-subtree! target)))))
|
||||
(define
|
||||
hs-set-element!
|
||||
(fn
|
||||
(target value)
|
||||
(let ((parent (dom-parent target)))
|
||||
(when parent
|
||||
(let ((tmp (dom-create-element "div"))
|
||||
(str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) value)))
|
||||
(do
|
||||
(dom-set-inner-html tmp str-val)
|
||||
(let ((children (host-get tmp "children")))
|
||||
(if (> (len children) 0)
|
||||
(let ((new-el (first children)))
|
||||
(do
|
||||
(host-call parent "replaceChild" new-el target)
|
||||
(hs-boot-subtree! new-el)))
|
||||
(hs-set-inner-html! target str-val)))))))))
|
||||
(do (dom-set-inner-html target value) (hs-boot-subtree! target))))
|
||||
(define
|
||||
hs-put!
|
||||
(fn
|
||||
@@ -392,10 +355,9 @@
|
||||
(dom-insert-adjacent-html target "beforeend" value)
|
||||
(hs-boot-subtree! target)))))))))
|
||||
|
||||
;; ── Fetch ───────────────────────────────────────────────────────
|
||||
;; ── Iteration ───────────────────────────────────────────────────
|
||||
|
||||
;; Fetch a URL, parse response according to format.
|
||||
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
||||
;; Repeat a thunk N times.
|
||||
(define
|
||||
hs-add-to!
|
||||
(fn
|
||||
@@ -408,10 +370,7 @@
|
||||
(append target (list value))))
|
||||
(true (do (host-call target "push" value) target)))))
|
||||
|
||||
;; ── Type coercion ───────────────────────────────────────────────
|
||||
|
||||
;; Coerce a value to a type by name.
|
||||
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
||||
;; Repeat forever (until break — relies on exception/continuation).
|
||||
(define
|
||||
hs-remove-from!
|
||||
(fn
|
||||
@@ -421,10 +380,10 @@
|
||||
(filter (fn (x) (not (= x value))) target)
|
||||
(host-call target "splice" (host-call target "indexOf" value) 1))))
|
||||
|
||||
;; ── Object creation ─────────────────────────────────────────────
|
||||
;; ── Fetch ───────────────────────────────────────────────────────
|
||||
|
||||
;; Make a new object of a given type.
|
||||
;; (hs-make type-name) — creates empty object/collection
|
||||
;; Fetch a URL, parse response according to format.
|
||||
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
||||
(define
|
||||
hs-splice-at!
|
||||
(fn
|
||||
@@ -448,11 +407,10 @@
|
||||
(host-call target "splice" i 1))))
|
||||
target))))
|
||||
|
||||
;; ── Behavior installation ───────────────────────────────────────
|
||||
;; ── Type coercion ───────────────────────────────────────────────
|
||||
|
||||
;; 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)
|
||||
;; Coerce a value to a type by name.
|
||||
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
||||
(define
|
||||
hs-index
|
||||
(fn
|
||||
@@ -464,10 +422,10 @@
|
||||
((string? obj) (nth obj key))
|
||||
(true (host-get obj key)))))
|
||||
|
||||
;; ── Measurement ─────────────────────────────────────────────────
|
||||
;; ── Object creation ─────────────────────────────────────────────
|
||||
|
||||
;; Measure an element's bounding rect, store as local variables.
|
||||
;; Returns a dict with x, y, width, height, top, left, right, bottom.
|
||||
;; Make a new object of a given type.
|
||||
;; (hs-make type-name) — creates empty object/collection
|
||||
(define
|
||||
hs-put-at!
|
||||
(fn
|
||||
@@ -489,10 +447,11 @@
|
||||
((= pos "start") (host-call target "unshift" value)))
|
||||
target)))))))
|
||||
|
||||
;; Return the current text selection as a string. In the browser this is
|
||||
;; `window.getSelection().toString()`. In the mock test runner, a test
|
||||
;; setup stashes the desired selection text at `window.__test_selection`
|
||||
;; and the fallback path returns that so tests can assert on the result.
|
||||
;; ── 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-dict-without
|
||||
(fn
|
||||
@@ -513,19 +472,27 @@
|
||||
(host-call (host-global "Reflect") "deleteProperty" out key)
|
||||
out)))))
|
||||
|
||||
;; ── Measurement ─────────────────────────────────────────────────
|
||||
|
||||
;; ── Transition ──────────────────────────────────────────────────
|
||||
|
||||
;; Transition a CSS property to a value, optionally with duration.
|
||||
;; (hs-transition target prop value duration)
|
||||
;; Measure an element's bounding rect, store as local variables.
|
||||
;; Returns a dict with x, y, width, height, top, left, right, bottom.
|
||||
(define
|
||||
hs-set-on!
|
||||
(fn
|
||||
(props target)
|
||||
(for-each (fn (k) (host-set! target k (get props k))) (keys props))))
|
||||
|
||||
;; Return the current text selection as a string. In the browser this is
|
||||
;; `window.getSelection().toString()`. In the mock test runner, a test
|
||||
;; setup stashes the desired selection text at `window.__test_selection`
|
||||
;; and the fallback path returns that so tests can assert on the result.
|
||||
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
|
||||
|
||||
|
||||
;; ── Transition ──────────────────────────────────────────────────
|
||||
|
||||
;; Transition a CSS property to a value, optionally with duration.
|
||||
;; (hs-transition target prop value duration)
|
||||
(define
|
||||
hs-ask
|
||||
(fn
|
||||
@@ -580,7 +547,7 @@
|
||||
(do
|
||||
(host-call ev "preventDefault")
|
||||
(host-call ev "stopPropagation")))))
|
||||
(when (not (= mode "the-event")) (raise (list (if (= mode "default") "hs-halt-default" "hs-return") nil))))))
|
||||
(when (not (= mode "the-event")) (raise (list "hs-return" nil))))))
|
||||
|
||||
(define hs-select! (fn (target) (host-call target "select" (list))))
|
||||
|
||||
@@ -664,10 +631,6 @@
|
||||
(true (find-next (dom-next-sibling el))))))
|
||||
(find-next sibling)))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define
|
||||
hs-previous
|
||||
(fn
|
||||
@@ -690,8 +653,11 @@
|
||||
(define
|
||||
hs-query-all
|
||||
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define
|
||||
hs-query-all-in
|
||||
(fn
|
||||
@@ -700,23 +666,22 @@
|
||||
(nil? target)
|
||||
(hs-query-all sel)
|
||||
(host-call target "querySelectorAll" sel))))
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
|
||||
(define
|
||||
hs-list-set
|
||||
(fn
|
||||
(lst idx val)
|
||||
(append (take lst idx) (cons val (drop lst (+ idx 1))))))
|
||||
;; Method dispatch — obj.method(args)
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
(define
|
||||
hs-to-number
|
||||
(fn (v) (if (number? v) v (or (parse-number (str v)) 0))))
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
(define
|
||||
hs-query-first
|
||||
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
|
||||
;; Property-based is — check obj.key truthiness
|
||||
;; Method dispatch — obj.method(args)
|
||||
(define
|
||||
hs-query-last
|
||||
(fn
|
||||
@@ -724,9 +689,11 @@
|
||||
(let
|
||||
((all (dom-query-all (dom-body) sel)))
|
||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||
;; Array slicing (inclusive both ends)
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
(define hs-first (fn (scope sel) (dom-query-all scope sel)))
|
||||
;; Collection: sorted by
|
||||
;; Property-based is — check obj.key truthiness
|
||||
(define
|
||||
hs-last
|
||||
(fn
|
||||
@@ -734,7 +701,7 @@
|
||||
(let
|
||||
((all (dom-query-all scope sel)))
|
||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||
;; Collection: sorted by descending
|
||||
;; Array slicing (inclusive both ends)
|
||||
(define
|
||||
hs-repeat-times
|
||||
(fn
|
||||
@@ -752,7 +719,7 @@
|
||||
((= signal "hs-continue") (do-repeat (+ i 1)))
|
||||
(true (do-repeat (+ i 1))))))))
|
||||
(do-repeat 0)))
|
||||
;; Collection: split by
|
||||
;; Collection: sorted by
|
||||
(define
|
||||
hs-repeat-forever
|
||||
(fn
|
||||
@@ -768,7 +735,7 @@
|
||||
((= signal "hs-continue") (do-forever))
|
||||
(true (do-forever))))))
|
||||
(do-forever)))
|
||||
;; Collection: joined by
|
||||
;; Collection: sorted by descending
|
||||
(define
|
||||
hs-repeat-while
|
||||
(fn
|
||||
@@ -781,7 +748,7 @@
|
||||
((= signal "hs-break") nil)
|
||||
((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
|
||||
(true (hs-repeat-while cond-fn thunk)))))))
|
||||
|
||||
;; Collection: split by
|
||||
(define
|
||||
hs-repeat-until
|
||||
(fn
|
||||
@@ -793,13 +760,13 @@
|
||||
((= signal "hs-continue")
|
||||
(if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
|
||||
(true (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))))))
|
||||
|
||||
;; Collection: joined by
|
||||
(define
|
||||
hs-for-each
|
||||
(fn
|
||||
(fn-body collection)
|
||||
(let
|
||||
((items (cond ((list? collection) collection) ((nil? collection) (list)) ((host-iter? collection) (host-to-list collection)) ((dict? collection) (if (dict-has? collection "_order") (get collection "_order") (filter (fn (k) (not (= k "_order"))) (keys collection)))) (true (list)))))
|
||||
((items (cond ((list? collection) collection) ((dict? collection) (if (dict-has? collection "_order") (get collection "_order") (filter (fn (k) (not (= k "_order"))) (keys collection)))) ((nil? collection) (list)) (true (list)))))
|
||||
(define
|
||||
do-loop
|
||||
(fn
|
||||
@@ -829,8 +796,7 @@
|
||||
(append target (list value))))
|
||||
((hs-element? target)
|
||||
(do
|
||||
(dom-insert-adjacent-html target "beforeend"
|
||||
(if (hs-element? value) (host-get value "outerHTML") (str value)))
|
||||
(dom-insert-adjacent-html target "beforeend" (str value))
|
||||
target))
|
||||
(true (str target value)))))
|
||||
(define
|
||||
@@ -840,8 +806,7 @@
|
||||
(cond
|
||||
((nil? target) nil)
|
||||
((hs-element? target)
|
||||
(dom-insert-adjacent-html target "beforeend"
|
||||
(if (hs-element? value) (host-get value "outerHTML") (str value))))
|
||||
(dom-insert-adjacent-html target "beforeend" (str value)))
|
||||
(true nil)))))
|
||||
|
||||
(define
|
||||
@@ -907,44 +872,14 @@
|
||||
out)))))))))))
|
||||
|
||||
(define
|
||||
hs-fetch-impl
|
||||
hs-fetch
|
||||
(fn
|
||||
(url format no-throw)
|
||||
(url format)
|
||||
(let
|
||||
((fmt (cond
|
||||
((nil? format) "text")
|
||||
((or (= format "json") (= format "JSON") (= format "Object")) "json")
|
||||
((or (= format "html") (= format "HTML")) "html")
|
||||
((or (= format "response") (= format "Response")) "response")
|
||||
((or (= format "text") (= format "Text")) "text")
|
||||
((or (= format "number") (= format "Number")) "number")
|
||||
(true "text"))))
|
||||
(let
|
||||
((_hs-before-caller (host-get meta "owner")))
|
||||
(when _hs-before-caller
|
||||
(dom-dispatch _hs-before-caller "hyperscript:beforeFetch" {:url url})))
|
||||
((fmt (cond ((nil? format) "text") ((or (= format "json") (= format "JSON") (= format "Object")) "json") ((or (= format "html") (= format "HTML")) "html") ((or (= format "response") (= format "Response")) "response") ((or (= format "text") (= format "Text")) "text") (true format))))
|
||||
(let
|
||||
((raw (perform (list "io-fetch" url fmt))))
|
||||
(begin
|
||||
(when (= (host-get raw "_network-error") true)
|
||||
(raise (or (host-get raw "message") "Network error")))
|
||||
(when (and (not no-throw) (not (= fmt "response")) (= (host-get raw "ok") false))
|
||||
(raise (str "HTTP Error: " (host-get raw "status"))))
|
||||
(cond
|
||||
((= fmt "response") raw)
|
||||
((= fmt "json")
|
||||
(hs-host-to-sx (perform (list "io-parse-json" raw))))
|
||||
((= fmt "number")
|
||||
(hs-to-number (perform (list "io-parse-text" raw))))
|
||||
(true (perform (list "io-parse-text" raw)))))))))
|
||||
|
||||
(define
|
||||
hs-fetch
|
||||
(fn (url format) (hs-fetch-impl url format false)))
|
||||
|
||||
(define
|
||||
hs-fetch-no-throw
|
||||
(fn (url format) (hs-fetch-impl url format true)))
|
||||
(cond ((= fmt "json") (hs-host-to-sx raw)) (true raw))))))
|
||||
|
||||
(define
|
||||
hs-json-escape
|
||||
@@ -1035,10 +970,9 @@
|
||||
(true (str value))))
|
||||
((= type-name "JSON")
|
||||
(cond
|
||||
((string? value) (guard (_e (true value)) (hs-host-to-sx (json-parse value))))
|
||||
((not (nil? (host-get value "_json")))
|
||||
(hs-host-to-sx (perform (list "io-parse-json" value))))
|
||||
((dict? value) value)
|
||||
((string? value) (guard (_e (true value)) (json-parse value)))
|
||||
((dict? value) (hs-json-stringify value))
|
||||
((list? value) (hs-json-stringify value))
|
||||
(true value)))
|
||||
((= type-name "Object")
|
||||
(if
|
||||
@@ -1197,17 +1131,7 @@
|
||||
(if
|
||||
(host-get node "multiple")
|
||||
(hs-select-multi-values node)
|
||||
(let
|
||||
((idx (host-get node "selectedIndex"))
|
||||
(opts (host-get node "options"))
|
||||
(raw-val (host-get node "value")))
|
||||
(if
|
||||
(and (not (nil? raw-val)) (not (= raw-val "")))
|
||||
raw-val
|
||||
(if
|
||||
(and (not (nil? opts)) (>= idx 0))
|
||||
(host-get (if (list? opts) (nth opts idx) (host-get opts idx)) "value")
|
||||
"")))))
|
||||
(host-get node "value")))
|
||||
((or (= typ "checkbox") (= typ "radio"))
|
||||
(if (host-get node "checked") (host-get node "value") nil))
|
||||
(true (host-get node "value"))))))
|
||||
@@ -1424,21 +1348,14 @@
|
||||
hs-transition
|
||||
(fn
|
||||
(target prop value duration)
|
||||
(let
|
||||
((init-attr (str "data-hs-init-" prop)))
|
||||
(when
|
||||
(not (dom-get-attr target init-attr))
|
||||
(dom-set-attr target init-attr (dom-get-style target prop)))
|
||||
(let
|
||||
((actual-value (if (= value "initial") (dom-get-attr target init-attr) value)))
|
||||
(when
|
||||
duration
|
||||
(dom-set-style
|
||||
target
|
||||
"transition"
|
||||
(str prop " " (/ duration 1000) "s")))
|
||||
(dom-set-style target prop actual-value)
|
||||
(when duration (hs-settle target))))))
|
||||
(when
|
||||
duration
|
||||
(dom-set-style
|
||||
target
|
||||
"transition"
|
||||
(str prop " " (/ duration 1000) "s")))
|
||||
(dom-set-style target prop value)
|
||||
(when duration (hs-settle target))))
|
||||
|
||||
(define
|
||||
hs-transition-from
|
||||
@@ -1501,15 +1418,6 @@
|
||||
hs-strict-eq
|
||||
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
|
||||
|
||||
(define
|
||||
hs-id=
|
||||
(fn
|
||||
(a b)
|
||||
(if
|
||||
(and (= (host-typeof a) "element") (= (host-typeof b) "element"))
|
||||
(hs-ref-eq a b)
|
||||
(= a b))))
|
||||
|
||||
(define
|
||||
hs-eq-ignore-case
|
||||
(fn (a b) (= (downcase (str a)) (downcase (str b)))))
|
||||
@@ -2189,13 +2097,20 @@
|
||||
(fn
|
||||
(pairs)
|
||||
(let
|
||||
((d {}))
|
||||
((d {}) (order (list)))
|
||||
(do
|
||||
(for-each
|
||||
(fn
|
||||
(pair)
|
||||
(dict-set! d (first pair) (nth pair 1)))
|
||||
(let
|
||||
((k (first pair)))
|
||||
(do
|
||||
(when
|
||||
(not (dict-has? d k))
|
||||
(set! order (append order (list k))))
|
||||
(dict-set! d k (nth pair 1)))))
|
||||
pairs)
|
||||
(when (not (empty? order)) (dict-set! d "_order" order))
|
||||
d))))
|
||||
|
||||
(define
|
||||
@@ -2596,8 +2511,6 @@
|
||||
((nth entry 2) val)))
|
||||
_hs-dom-watchers)))
|
||||
|
||||
;; ── SourceInfo API ────────────────────────────────────────────────
|
||||
|
||||
(define
|
||||
hs-dom-is-ancestor?
|
||||
(fn
|
||||
@@ -2613,208 +2526,111 @@
|
||||
(fn-name args)
|
||||
(let ((fn (host-global fn-name))) (if fn (host-call-fn fn args) nil))))
|
||||
|
||||
(define
|
||||
hs-source-for
|
||||
(fn
|
||||
(node)
|
||||
(substring (get node :src) (get node :start) (get node :end))))
|
||||
;; ── WebSocket / socket feature ───────────────────────────────────
|
||||
|
||||
(define
|
||||
hs-line-for
|
||||
hs-try-json-parse
|
||||
(fn (s) (host-call (host-global "JSON") "parse" s)))
|
||||
|
||||
(define
|
||||
hs-socket-resolve-rpc!
|
||||
(fn
|
||||
(node)
|
||||
(wrapper msg)
|
||||
(let
|
||||
((lines (split (get node :src) "\n"))
|
||||
(line-idx (- (get node :line) 1)))
|
||||
(if (< line-idx (len lines)) (nth lines line-idx) ""))))
|
||||
|
||||
(define hs-node-get (fn (node key) (get (get node :fields) key)))
|
||||
|
||||
(define hs-src (fn (src-str) (hs-source-for (hs-parse-ast src-str))))
|
||||
|
||||
(define
|
||||
hs-src-at
|
||||
(fn
|
||||
(src-str path)
|
||||
(define
|
||||
walk
|
||||
(fn
|
||||
(node keys)
|
||||
(if
|
||||
(or (nil? keys) (= (len keys) 0))
|
||||
node
|
||||
(walk (hs-node-get node (first keys)) (rest keys)))))
|
||||
(hs-source-for (walk (hs-parse-ast src-str) path))))
|
||||
|
||||
(define
|
||||
hs-line-at
|
||||
(fn
|
||||
(src-str path)
|
||||
(define
|
||||
walk
|
||||
(fn
|
||||
(node keys)
|
||||
(if
|
||||
(or (nil? keys) (= (len keys) 0))
|
||||
node
|
||||
(walk (hs-node-get node (first keys)) (rest keys)))))
|
||||
(hs-line-for (walk (hs-parse-ast src-str) path))))
|
||||
|
||||
(define
|
||||
hs-js-exec
|
||||
(fn
|
||||
(param-names js-src bound-args)
|
||||
(let
|
||||
((js-fn (host-new-function param-names js-src)))
|
||||
((pending (host-get wrapper "pending")) (iid (host-get msg "iid")))
|
||||
(let
|
||||
((result (host-call-fn js-fn bound-args)))
|
||||
(if
|
||||
(= (host-typeof result) "promise")
|
||||
(let
|
||||
((state (host-promise-state result)))
|
||||
(if
|
||||
(and state (= (host-get state "ok") false))
|
||||
(raise (host-get state "value"))
|
||||
(if state (host-get state "value") result)))
|
||||
result)))))
|
||||
|
||||
(define
|
||||
hs-raw->api-token
|
||||
(fn
|
||||
(raw)
|
||||
(let
|
||||
((type (dict-get raw :type)) (value (dict-get raw :value)))
|
||||
(cond
|
||||
(= type "ident")
|
||||
{:value value :type "IDENTIFIER" :op false}
|
||||
(= type "keyword")
|
||||
{:value value :type "IDENTIFIER" :op false}
|
||||
(= type "number")
|
||||
{:value value :type "NUMBER" :op false}
|
||||
(= type "string")
|
||||
{:value value :type "STRING" :op false}
|
||||
(= type "class")
|
||||
{:value (str "." value) :type "CLASS_REF" :op false}
|
||||
(= type "id")
|
||||
{:value (str "#" value) :type "ID_REF" :op false}
|
||||
(= type "attr")
|
||||
{:value value :type "ATTRIBUTE_REF" :op false}
|
||||
(= type "style")
|
||||
{:value value :type "STYLE_REF" :op false}
|
||||
(= type "selector")
|
||||
{:value value :type "QUERY_REF" :op false}
|
||||
(= type "eof")
|
||||
{:value "<<<EOF>>>" :type "EOF" :op false}
|
||||
(= type "paren-open")
|
||||
{:value value :type "L_PAREN" :op true}
|
||||
(= type "paren-close")
|
||||
{:value value :type "R_PAREN" :op true}
|
||||
(= type "bracket-open")
|
||||
{:value value :type "L_BRACKET" :op true}
|
||||
(= type "bracket-close")
|
||||
{:value value :type "R_BRACKET" :op true}
|
||||
(= type "brace-open")
|
||||
{:value value :type "L_BRACE" :op true}
|
||||
(= type "brace-close")
|
||||
{:value value :type "R_BRACE" :op true}
|
||||
(= type "comma")
|
||||
{:value value :type "COMMA" :op true}
|
||||
(= type "dot")
|
||||
{:value value :type "PERIOD" :op true}
|
||||
(= type "colon")
|
||||
{:value value :type "COLON" :op true}
|
||||
(= type "op")
|
||||
(cond
|
||||
(= value "+") {:value value :type "PLUS" :op true}
|
||||
(= value "-") {:value value :type "MINUS" :op true}
|
||||
(= value "*") {:value value :type "MULTIPLY" :op true}
|
||||
(= value "/") {:value value :type "SLASH" :op true}
|
||||
(= value "!") {:value value :type "EXCLAMATION" :op true}
|
||||
(= value "?") {:value value :type "QUESTION" :op true}
|
||||
(= value "#") {:value value :type "POUND" :op true}
|
||||
(= value "&") {:value value :type "AMPERSAND" :op true}
|
||||
(= value "=") {:value value :type "EQUALS" :op true}
|
||||
(= value "<") {:value value :type "L_ANG" :op true}
|
||||
(= value ">") {:value value :type "R_ANG" :op true}
|
||||
(= value "<=") {:value value :type "LTE_ANG" :op true}
|
||||
(= value ">=") {:value value :type "GTE_ANG" :op true}
|
||||
(= value "==") {:value value :type "EQ" :op true}
|
||||
(= value "===") {:value value :type "EQQ" :op true}
|
||||
(= value "..") {:value value :type "PERIOD_PERIOD" :op true}
|
||||
:else {:value value :type value :op true})
|
||||
:else {:value (or value "") :type (str type) :op false}))))
|
||||
|
||||
(define hs-eof-sentinel {:value "<<<EOF>>>" :type "EOF" :op false})
|
||||
|
||||
(define
|
||||
hs-tokens-of
|
||||
(fn
|
||||
(src &rest args)
|
||||
(let
|
||||
((template (some (fn (a) (equal? a :template)) args)))
|
||||
(let
|
||||
((raw (if template (hs-tokenize-template src) (hs-tokenize src))))
|
||||
{:pos 0 :list (filter (fn (t) (not (= (dict-get t :type) "EOF"))) (map hs-raw->api-token raw)) :source src}))))
|
||||
|
||||
(define
|
||||
hs-stream-token
|
||||
(fn
|
||||
(s i)
|
||||
(let
|
||||
((lst (dict-get s :list))
|
||||
(n (len (dict-get s :list))))
|
||||
(define
|
||||
find
|
||||
(fn
|
||||
(pos count)
|
||||
((resolver (host-get pending iid)))
|
||||
(when
|
||||
(not (nil? resolver))
|
||||
(if
|
||||
(>= pos n)
|
||||
hs-eof-sentinel
|
||||
(let
|
||||
((tok (nth lst pos)))
|
||||
(if
|
||||
(= (dict-get tok :type) "whitespace")
|
||||
(find (+ pos 1) count)
|
||||
(if
|
||||
(= count 0)
|
||||
tok
|
||||
(find (+ pos 1) (- count 1))))))))
|
||||
(find (dict-get s :pos) i))))
|
||||
(not (nil? (host-get msg "return")))
|
||||
(host-call resolver "resolve" (host-get msg "return"))
|
||||
(host-call resolver "reject" (host-get msg "throw")))
|
||||
(host-set! pending iid nil))))))
|
||||
|
||||
(define
|
||||
hs-stream-consume
|
||||
hs-socket-register!
|
||||
(fn
|
||||
(s)
|
||||
(name-path url timeout-ms handler json?)
|
||||
(let
|
||||
((lst (dict-get s :list))
|
||||
(n (len (dict-get s :list))))
|
||||
(define
|
||||
find-pos
|
||||
(fn
|
||||
(pos)
|
||||
(if
|
||||
(>= pos n)
|
||||
pos
|
||||
(if
|
||||
(= (dict-get (nth lst pos) :type) "whitespace")
|
||||
(find-pos (+ pos 1))
|
||||
pos))))
|
||||
((ws-url (cond ((or (starts-with? url "ws://") (starts-with? url "wss://")) url) (true (let ((proto (host-get (host-global "location") "protocol")) (h (host-get (host-global "location") "host"))) (str (if (= proto "https:") "wss:" "ws:") "//" h url))))))
|
||||
(let
|
||||
((p (find-pos (dict-get s :pos))))
|
||||
((ws (host-new "WebSocket" ws-url)))
|
||||
(let
|
||||
((tok (if (>= p n) hs-eof-sentinel (nth lst p))))
|
||||
(do
|
||||
((wrapper (host-new "Object")))
|
||||
(host-set! wrapper "raw" ws)
|
||||
(host-set! wrapper "url" ws-url)
|
||||
(host-set! wrapper "timeout" timeout-ms)
|
||||
(host-set! wrapper "pending" (host-new "Object"))
|
||||
(host-set! wrapper "handler" handler)
|
||||
(host-set! wrapper "json?" json?)
|
||||
(host-set! wrapper "closed?" false)
|
||||
(host-set! wrapper "closedFlag" nil)
|
||||
(let
|
||||
((proxy-factory (host-global "_hs_make_rpc_proxy")))
|
||||
(when
|
||||
(not (= (dict-get tok :type) "EOF"))
|
||||
(dict-set! s :pos (+ p 1)))
|
||||
tok))))))
|
||||
|
||||
(define
|
||||
hs-stream-has-more
|
||||
(fn (s) (not (= (dict-get (hs-stream-token s 0) :type) "EOF"))))
|
||||
|
||||
(define hs-token-type (fn (tok) (dict-get tok :type)))
|
||||
|
||||
(define hs-token-value (fn (tok) (dict-get tok :value)))
|
||||
|
||||
(define hs-token-op? (fn (tok) (dict-get tok :op)))
|
||||
proxy-factory
|
||||
(host-set!
|
||||
wrapper
|
||||
"rpc"
|
||||
(host-call proxy-factory "call" nil wrapper))))
|
||||
(host-set!
|
||||
ws
|
||||
"onmessage"
|
||||
(host-callback
|
||||
(fn
|
||||
(event)
|
||||
(let
|
||||
((data (host-get event "data")))
|
||||
(let
|
||||
((parsed (hs-try-json-parse data)))
|
||||
(cond
|
||||
((and (not (nil? parsed)) (not (nil? (host-get parsed "iid"))))
|
||||
(hs-socket-resolve-rpc! wrapper parsed))
|
||||
((not (nil? handler))
|
||||
(if
|
||||
json?
|
||||
(if
|
||||
(not (nil? parsed))
|
||||
(handler parsed)
|
||||
(error "Received non-JSON message"))
|
||||
(handler event)))))))))
|
||||
(host-call
|
||||
ws
|
||||
"addEventListener"
|
||||
"close"
|
||||
(host-callback
|
||||
(fn
|
||||
(evt)
|
||||
(host-set! wrapper "closedFlag" "1"))))
|
||||
(host-set!
|
||||
wrapper
|
||||
"dispatchEvent"
|
||||
(host-callback
|
||||
(fn
|
||||
(evt)
|
||||
(let
|
||||
((payload (host-new "Object")))
|
||||
(host-set! payload "type" (host-get evt "type"))
|
||||
(host-call
|
||||
(host-get wrapper "raw")
|
||||
"send"
|
||||
(host-call
|
||||
(host-global "JSON")
|
||||
"stringify"
|
||||
payload))))))
|
||||
(define
|
||||
bind-path!
|
||||
(fn
|
||||
(obj path)
|
||||
(if
|
||||
(= (len path) 1)
|
||||
(host-set! obj (first path) wrapper)
|
||||
(let
|
||||
((key (first path)) (rest-path (rest path)))
|
||||
(let
|
||||
((next (or (host-get obj key) (host-new "Object"))))
|
||||
(host-set! obj key next)
|
||||
(bind-path! next rest-path))))))
|
||||
(bind-path! (host-global "window") name-path)
|
||||
wrapper)))))
|
||||
|
||||
@@ -28,27 +28,6 @@
|
||||
|
||||
(define hs-ws? (fn (c) (or (= c " ") (= c "\t") (= c "\n") (= c "\r"))))
|
||||
|
||||
(define
|
||||
hs-hex-digit?
|
||||
(fn
|
||||
(c)
|
||||
(or
|
||||
(and (>= c "0") (<= c "9"))
|
||||
(and (>= c "a") (<= c "f"))
|
||||
(and (>= c "A") (<= c "F")))))
|
||||
|
||||
(define
|
||||
hs-hex-val
|
||||
(fn
|
||||
(c)
|
||||
(let
|
||||
((code (char-code c)))
|
||||
(cond
|
||||
((and (>= code 48) (<= code 57)) (- code 48))
|
||||
((and (>= code 65) (<= code 70)) (- code 55))
|
||||
((and (>= code 97) (<= code 102)) (- code 87))
|
||||
(true 0)))))
|
||||
|
||||
;; ── Keyword set ───────────────────────────────────────────────────
|
||||
|
||||
(define
|
||||
@@ -131,7 +110,6 @@
|
||||
"append"
|
||||
"settle"
|
||||
"transition"
|
||||
"view"
|
||||
"over"
|
||||
"closest"
|
||||
"next"
|
||||
@@ -257,15 +235,10 @@
|
||||
read-number
|
||||
(fn
|
||||
(start)
|
||||
(define
|
||||
read-int
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(and (< pos src-len) (hs-digit? (hs-cur)))
|
||||
(hs-advance! 1)
|
||||
(read-int))))
|
||||
(read-int)
|
||||
(when
|
||||
(and (< pos src-len) (hs-digit? (hs-cur)))
|
||||
(hs-advance! 1)
|
||||
(read-number start))
|
||||
(when
|
||||
(and
|
||||
(< pos src-len)
|
||||
@@ -273,7 +246,15 @@
|
||||
(< (+ pos 1) src-len)
|
||||
(hs-digit? (hs-peek 1)))
|
||||
(hs-advance! 1)
|
||||
(read-int))
|
||||
(define
|
||||
read-frac
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(and (< pos src-len) (hs-digit? (hs-cur)))
|
||||
(hs-advance! 1)
|
||||
(read-frac))))
|
||||
(read-frac))
|
||||
(do
|
||||
(when
|
||||
(and
|
||||
@@ -291,7 +272,15 @@
|
||||
(< pos src-len)
|
||||
(or (= (hs-cur) "+") (= (hs-cur) "-")))
|
||||
(hs-advance! 1))
|
||||
(read-int))
|
||||
(define
|
||||
read-exp-digits
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(and (< pos src-len) (hs-digit? (hs-cur)))
|
||||
(hs-advance! 1)
|
||||
(read-exp-digits))))
|
||||
(read-exp-digits))
|
||||
(let
|
||||
((num-end pos))
|
||||
(when
|
||||
@@ -319,7 +308,7 @@
|
||||
()
|
||||
(cond
|
||||
(>= pos src-len)
|
||||
(error "Unterminated string")
|
||||
nil
|
||||
(= (hs-cur) "\\")
|
||||
(do
|
||||
(hs-advance! 1)
|
||||
@@ -329,37 +318,15 @@
|
||||
((ch (hs-cur)))
|
||||
(cond
|
||||
(= ch "n")
|
||||
(do (append! chars "\n") (hs-advance! 1))
|
||||
(append! chars "\n")
|
||||
(= ch "t")
|
||||
(do (append! chars "\t") (hs-advance! 1))
|
||||
(= ch "r")
|
||||
(do (append! chars "\r") (hs-advance! 1))
|
||||
(= ch "b")
|
||||
(do (append! chars (char-from-code 8)) (hs-advance! 1))
|
||||
(= ch "f")
|
||||
(do (append! chars (char-from-code 12)) (hs-advance! 1))
|
||||
(= ch "v")
|
||||
(do (append! chars (char-from-code 11)) (hs-advance! 1))
|
||||
(append! chars "\t")
|
||||
(= ch "\\")
|
||||
(do (append! chars "\\") (hs-advance! 1))
|
||||
(append! chars "\\")
|
||||
(= ch quote-char)
|
||||
(do (append! chars quote-char) (hs-advance! 1))
|
||||
(= ch "x")
|
||||
(do
|
||||
(hs-advance! 1)
|
||||
(if
|
||||
(and
|
||||
(< (+ pos 1) src-len)
|
||||
(hs-hex-digit? (hs-cur))
|
||||
(hs-hex-digit? (hs-peek 1)))
|
||||
(let
|
||||
((d1 (hs-hex-val (hs-cur)))
|
||||
(d2 (hs-hex-val (hs-peek 1))))
|
||||
(append! chars (char-from-code (+ (* d1 16) d2)))
|
||||
(hs-advance! 2))
|
||||
(error "Invalid hexadecimal escape: \\x")))
|
||||
:else
|
||||
(do (append! chars "\\") (append! chars ch) (hs-advance! 1)))))
|
||||
(append! chars quote-char)
|
||||
:else (do (append! chars "\\") (append! chars ch)))
|
||||
(hs-advance! 1)))
|
||||
(loop))
|
||||
(= (hs-cur) quote-char)
|
||||
(hs-advance! 1)
|
||||
@@ -461,23 +428,12 @@
|
||||
hs-emit!
|
||||
(fn
|
||||
(type value start)
|
||||
(let
|
||||
((tok (hs-make-token type value start))
|
||||
(end-pos (max pos (+ start (if (nil? value) 0 (len (str value)))))))
|
||||
(do
|
||||
(dict-set! tok "end" end-pos)
|
||||
(dict-set! tok "line" (len (split (slice src 0 start) "\n")))
|
||||
(append! tokens tok)))))
|
||||
(append! tokens (hs-make-token type value start))))
|
||||
(define
|
||||
scan!
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((ws-start pos))
|
||||
(skip-ws!)
|
||||
(when
|
||||
(and (> (len tokens) 0) (> pos ws-start))
|
||||
(hs-emit! "whitespace" (slice src ws-start pos) ws-start)))
|
||||
(skip-ws!)
|
||||
(when
|
||||
(< pos src-len)
|
||||
(let
|
||||
@@ -485,7 +441,11 @@
|
||||
(cond
|
||||
(and (= ch "-") (< (+ pos 1) src-len) (= (hs-peek 1) "-"))
|
||||
(do (hs-advance! 2) (skip-comment!) (scan!))
|
||||
(and (= ch "/") (< (+ pos 1) src-len) (= (hs-peek 1) "/"))
|
||||
(and
|
||||
(= ch "/")
|
||||
(< (+ pos 1) src-len)
|
||||
(= (hs-peek 1) "/")
|
||||
(not (and (> pos 0) (= (hs-peek -1) ":"))))
|
||||
(do (hs-advance! 2) (skip-comment!) (scan!))
|
||||
(and
|
||||
(= ch "<")
|
||||
@@ -501,15 +461,6 @@
|
||||
(do (hs-emit! "selector" (read-selector) start) (scan!))
|
||||
(and (= ch ".") (< (+ pos 1) src-len) (= (hs-peek 1) "."))
|
||||
(do (hs-emit! "op" ".." start) (hs-advance! 2) (scan!))
|
||||
(and
|
||||
(= ch ".")
|
||||
(< (+ pos 1) src-len)
|
||||
(or (hs-letter? (hs-peek 1)) (= (hs-peek 1) "-") (= (hs-peek 1) "_"))
|
||||
(> (len tokens) 0)
|
||||
(let
|
||||
((lt (dict-get (nth tokens (- (len tokens) 1)) :type)))
|
||||
(or (= lt "paren-close") (= lt "brace-close") (= lt "bracket-close"))))
|
||||
(do (hs-emit! "dot" "." start) (hs-advance! 1) (scan!))
|
||||
(and
|
||||
(= ch ".")
|
||||
(< (+ pos 1) src-len)
|
||||
@@ -521,15 +472,6 @@
|
||||
(hs-advance! 1)
|
||||
(hs-emit! "class" (read-class-name pos) start)
|
||||
(scan!))
|
||||
(and
|
||||
(= ch "#")
|
||||
(< (+ pos 1) src-len)
|
||||
(hs-ident-start? (hs-peek 1))
|
||||
(> (len tokens) 0)
|
||||
(let
|
||||
((lt (dict-get (nth tokens (- (len tokens) 1)) :type)))
|
||||
(or (= lt "paren-close") (= lt "brace-close") (= lt "bracket-close"))))
|
||||
(do (hs-emit! "op" "#" start) (hs-advance! 1) (scan!))
|
||||
(and
|
||||
(= ch "#")
|
||||
(< (+ pos 1) src-len)
|
||||
@@ -598,26 +540,10 @@
|
||||
(do
|
||||
(let
|
||||
((word (read-ident start)))
|
||||
(let
|
||||
((full-word
|
||||
(if
|
||||
(and
|
||||
(< pos src-len)
|
||||
(= (hs-cur) "'")
|
||||
(< (+ pos 1) src-len)
|
||||
(hs-letter? (hs-peek 1))
|
||||
(not
|
||||
(and
|
||||
(= (hs-peek 1) "s")
|
||||
(or
|
||||
(>= (+ pos 2) src-len)
|
||||
(not (hs-ident-char? (hs-peek 2)))))))
|
||||
(do (hs-advance! 1) (str word "'" (read-ident pos)))
|
||||
word)))
|
||||
(hs-emit!
|
||||
(if (hs-keyword? full-word) "keyword" "ident")
|
||||
full-word
|
||||
start)))
|
||||
(hs-emit!
|
||||
(if (hs-keyword? word) "keyword" "ident")
|
||||
word
|
||||
start))
|
||||
(scan!))
|
||||
(and
|
||||
(or (= ch "=") (= ch "!") (= ch "<") (= ch ">"))
|
||||
@@ -698,82 +624,7 @@
|
||||
(do (hs-emit! "colon" ":" start) (hs-advance! 1) (scan!))
|
||||
(= ch "|")
|
||||
(do (hs-emit! "op" "|" start) (hs-advance! 1) (scan!))
|
||||
(= ch "&")
|
||||
(do (hs-emit! "op" "&" start) (hs-advance! 1) (scan!))
|
||||
(= ch "#")
|
||||
(do (hs-emit! "op" "#" start) (hs-advance! 1) (scan!))
|
||||
(= ch "?")
|
||||
(do (hs-emit! "op" "?" start) (hs-advance! 1) (scan!))
|
||||
(= ch ";")
|
||||
(do (hs-emit! "op" ";" start) (hs-advance! 1) (scan!))
|
||||
:else (do (hs-advance! 1) (scan!)))))))
|
||||
(scan!)
|
||||
(hs-emit! "eof" nil pos)
|
||||
tokens)))
|
||||
|
||||
;; ── Template-mode tokenizer (E37 API) ────────────────────────────────
|
||||
;; Used by hs-tokens-of when :template flag is set.
|
||||
;; Emits outer " chars as single STRING tokens; ${ ... } as $ { <inner-tokens> };
|
||||
;; inner content is tokenized with the regular hs-tokenize.
|
||||
|
||||
(define
|
||||
hs-tokenize-template
|
||||
(fn
|
||||
(src)
|
||||
(let
|
||||
((tokens (list)) (pos 0) (src-len (len src)))
|
||||
(define t-cur (fn () (if (< pos src-len) (nth src pos) nil)))
|
||||
(define t-peek (fn (n) (if (< (+ pos n) src-len) (nth src (+ pos n)) nil)))
|
||||
(define t-advance! (fn (n) (set! pos (+ pos n))))
|
||||
(define t-emit! (fn (type value) (append! tokens (hs-make-token type value pos))))
|
||||
(define
|
||||
scan-to-close!
|
||||
(fn
|
||||
(depth)
|
||||
(when
|
||||
(and (< pos src-len) (> depth 0))
|
||||
(cond
|
||||
(= (t-cur) "{")
|
||||
(do (t-advance! 1) (scan-to-close! (+ depth 1)))
|
||||
(= (t-cur) "}")
|
||||
(when (> (- depth 1) 0) (t-advance! 1) (scan-to-close! (- depth 1)))
|
||||
:else (do (t-advance! 1) (scan-to-close! depth))))))
|
||||
(define
|
||||
scan-template!
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(< pos src-len)
|
||||
(let
|
||||
((ch (t-cur)))
|
||||
(cond
|
||||
(= ch "\"")
|
||||
(do (t-emit! "string" "\"") (t-advance! 1) (scan-template!))
|
||||
(and (= ch "$") (= (t-peek 1) "{"))
|
||||
(do
|
||||
(t-emit! "op" "$")
|
||||
(t-advance! 1)
|
||||
(t-emit! "brace-open" "{")
|
||||
(t-advance! 1)
|
||||
(let
|
||||
((inner-start pos))
|
||||
(scan-to-close! 1)
|
||||
(let
|
||||
((inner-src (slice src inner-start pos))
|
||||
(inner-toks (hs-tokenize inner-src)))
|
||||
(for-each
|
||||
(fn (tok)
|
||||
(when (not (= (get tok "type") "eof"))
|
||||
(append! tokens tok)))
|
||||
inner-toks))
|
||||
(t-emit! "brace-close" "}")
|
||||
(when (< pos src-len) (t-advance! 1)))
|
||||
(scan-template!))
|
||||
(= ch "$")
|
||||
(do (t-emit! "op" "$") (t-advance! 1) (scan-template!))
|
||||
(hs-ws? ch)
|
||||
(do (t-advance! 1) (scan-template!))
|
||||
:else (do (t-advance! 1) (scan-template!)))))))
|
||||
(scan-template!)
|
||||
(t-emit! "eof" nil)
|
||||
tokens)))
|
||||
@@ -4,10 +4,10 @@ Live tally for `plans/hs-conformance-to-100.md`. Update after every cluster comm
|
||||
|
||||
```
|
||||
Baseline: 1213/1496 (81.1%)
|
||||
Merged: 1330/1496 (88.9%) delta +117
|
||||
Merged: 1303/1496 (87.1%) delta +90
|
||||
Worktree: all landed
|
||||
Target: 1496/1496 (100.0%)
|
||||
Remaining: ~174 tests (clusters 17/29(partial)/31 blocked; 33/34 partial)
|
||||
Remaining: ~194 tests (clusters 17/29(partial)/31 blocked; 33/34 partial)
|
||||
```
|
||||
|
||||
## Cluster ledger
|
||||
@@ -22,7 +22,7 @@ Remaining: ~174 tests (clusters 17/29(partial)/31 blocked; 33/34 partial)
|
||||
| 4 | `not` precedence over `or` | done | +3 | 4fe0b649 |
|
||||
| 5 | `some` selector for nonempty match | done | +1 | e7b86264 |
|
||||
| 6 | string template `${x}` | done | +2 | 108e25d4 |
|
||||
| 7 | `put` hyperscript reprocessing | done | +5 | 247bd85c |
|
||||
| 7 | `put` hyperscript reprocessing | partial | +1 | f21eb008 |
|
||||
| 8 | `select` returns selected text | done | +1 | d862efe8 |
|
||||
| 9 | `wait on event` basics | done | +4 | f79f96c1 |
|
||||
| 10 | `swap` variable ↔ property | done | +1 | 30f33341 |
|
||||
@@ -30,7 +30,7 @@ Remaining: ~174 tests (clusters 17/29(partial)/31 blocked; 33/34 partial)
|
||||
| 12 | `show` multi-element + display retention | done | +2 | 98c957b3 |
|
||||
| 13 | `toggle` multi-class + timed + until-event | partial | +2 | bd821c04 |
|
||||
| 14 | `unless` modifier | done | +1 | c4da0698 |
|
||||
| 15 | `transition` query-ref + multi-prop + initial | partial | +3 | 3d352055 |
|
||||
| 15 | `transition` query-ref + multi-prop + initial | partial | +2 | 3d352055 |
|
||||
| 16 | `send can reference sender` | done | +1 | ed8d71c9 |
|
||||
| 17 | `tell` semantics | blocked | — | — |
|
||||
| 18 | `throw` respond async/sync | done | +2 | dda3becb |
|
||||
@@ -66,29 +66,21 @@ Remaining: ~174 tests (clusters 17/29(partial)/31 blocked; 33/34 partial)
|
||||
| 33 | cookie API | partial | +4 |
|
||||
| 34 | event modifier DSL | partial | +7 |
|
||||
| 35 | namespaced `def` | done | +3 |
|
||||
| 36b | `call` result binds to `it` | done | +1 | 35f498ec |
|
||||
|
||||
### Bucket E — subsystems (design docs landed, pending review + implementation)
|
||||
|
||||
| # | Cluster | Status | Design doc |
|
||||
|---|---------|--------|------------|
|
||||
| 36 | WebSocket + `socket` + RPC proxy | design-done | `plans/designs/e36-websocket.md` |
|
||||
| 37 | Tokenizer-as-API | done | +17 | 54b54f4e |
|
||||
| 37 | Tokenizer-as-API | design-done | `plans/designs/e37-tokenizer-api.md` |
|
||||
| 38 | SourceInfo API | design-done | `plans/designs/e38-sourceinfo.md` |
|
||||
| 39 | WebWorker plugin | design-done | `plans/designs/e39-webworker.md` |
|
||||
| 40 | Fetch non-2xx / before-fetch / real response | done | +7 | d7244d1d |
|
||||
| 40 | Fetch non-2xx / before-fetch / real response | design-done | `plans/designs/e40-real-fetch.md` |
|
||||
|
||||
### Bucket F — generator translation gaps
|
||||
|
||||
Defer until A–D drain. Estimated ~25 recoverable tests.
|
||||
|
||||
| # | Cluster | Status | Δ | Commit |
|
||||
|---|---------|--------|---|--------|
|
||||
| F1 | add CSS template interpolation | done | +1 | 5a76a040 |
|
||||
| F2 | empty multi-element (query→for-each) | done | +1 | 875e9ba3 |
|
||||
| F3 | hs-make-object _order + assert= for dicts | done | +1 | daea2808 |
|
||||
| F4 | array literal arg to JS fn (sxToJs + reduce→SX) | done | +1 | da2e6b1b |
|
||||
|
||||
## Buckets roll-up
|
||||
|
||||
| Bucket | Done | Partial | In-prog | Pending | Blocked | Design-done | Total |
|
||||
@@ -97,7 +89,7 @@ Defer until A–D drain. Estimated ~25 recoverable tests.
|
||||
| B | 7 | 0 | 0 | 0 | 0 | — | 7 |
|
||||
| C | 4 | 1 | 0 | 0 | 0 | — | 5 |
|
||||
| D | 2 | 2 | 0 | 0 | 1 | — | 5 |
|
||||
| E | 2 | 0 | 0 | 0 | 0 | 3 | 5 |
|
||||
| E | 0 | 0 | 0 | 0 | 0 | 5 | 5 |
|
||||
| F | — | — | — | ~10 | — | — | ~10 |
|
||||
|
||||
## Maintenance
|
||||
|
||||
@@ -61,7 +61,7 @@ Orchestrator cherry-picks worktree commits onto `architecture` one at a time; re
|
||||
|
||||
6. **[done (+2)] string template `${x}`** — `expressions/strings / string templates work w/ props` + `w/ braces` (2 tests). Template interpolation isn't substituting property accesses. Check `hs-template` runtime. Expected: +2.
|
||||
|
||||
7. **[done (+5)] `put` hyperscript reprocessing** — `put / properly processes hyperscript at end/start/content/symbol` (4 tests, all `Expected 42, got 40`). After a put operation, newly inserted HS scripts aren't being activated. Fix: `hs-put-at!` should `hs-boot-subtree!` on the target after DOM insertion. Expected: +4.
|
||||
7. **[done (+1) — partial, 3 tests remain: inserted-button handler doesn't fire for afterbegin/innerHTML paths; might need targeted trace of hs-boot-subtree! or _setInnerHTML timing] `put` hyperscript reprocessing** — `put / properly processes hyperscript at end/start/content/symbol` (4 tests, all `Expected 42, got 40`). After a put operation, newly inserted HS scripts aren't being activated. Fix: `hs-put-at!` should `hs-boot-subtree!` on the target after DOM insertion. Expected: +4.
|
||||
|
||||
8. **[done (+1)] `select returns selected text`** (1 test, `hs-upstream-select`). Runtime `hs-get-selection` helper reads `window.__test_selection` stash (or falls back to real `window.getSelection().toString()`). Compiler rewrites `(ref "selection")` to `(hs-get-selection)`. Generator detects the `createRange` / `setStart` / `setEnd` / `addRange` block and emits a single `(host-set! ... __test_selection ...)` op with the resolved text slice of the target element. Expected: +1.
|
||||
|
||||
@@ -125,21 +125,19 @@ Orchestrator cherry-picks worktree commits onto `architecture` one at a time; re
|
||||
|
||||
35. **[done (+3)] namespaced `def`** — 3 tests. `def ns.foo() ...` creates `ns.foo`. Expected: +3.
|
||||
|
||||
36b. **[done (+1)] `call` result binds to `it`** — `call / call functions that return promises are waited on` (1 test). `call X then put it into Y` wasn't setting `it` because the `call` compiler branch emitted the call expression directly without `emit-set`. Fixed by wrapping in `emit-set (quote the-result) call-expr`. Expected: +1.
|
||||
|
||||
### Bucket E: subsystems (DO NOT LOOP — human-driven)
|
||||
|
||||
All five have design docs on their own worktree branches pending review + merge. After merge, status flips to `design-ready` and they become eligible for the loop.
|
||||
|
||||
36. **[design-done, pending review — `plans/designs/e36-websocket.md` on `worktree-agent-a9daf73703f520257`] WebSocket + `socket`** — 16 tests. Upstream shape is `socket NAME URL [with timeout N] [on message [as JSON] …] end` with an **implicit `.rpc` Proxy** (ES6 Proxy lives in JS, not SX), not `with proxy { send, receive }` as this row previously claimed. Design doc has 8-commit checklist, +12–16 delta estimate. Ship only with intentional design review.
|
||||
36. **[DONE +16 — branch `hs-e36-websocket`] WebSocket + `socket`** — 16/16 tests passing. `socket NAME URL [with timeout N] [on message [as JSON] …] end`, RPC proxy (dispatch-fn pattern), reconnect, dispatchEvent, timeout/noTimeout chains. All 16 upstream tests green.
|
||||
|
||||
37. **[done +17]** Tokenizer-as-API — `hs-tokens-of` / `hs-stream-token` / `hs-token-type` / `hs-token-value` / `hs-token-op?`; type-map + normalize; `read-number` dot-stop fix; `\$` template escape in compiler + runtime; generator pattern in `generate-sx-tests.py`. 17/17.
|
||||
37. **[design-done, pending review — `plans/designs/e37-tokenizer-api.md` on `worktree-agent-a6bb61d59cc0be8b4`] Tokenizer-as-API** — 17 tests. Expose tokens as inspectable SX data via `hs-tokens-of` / `hs-stream-token` / `hs-token-type` etc; type-map current `hs-tokenize` output to upstream SCREAMING_SNAKE_CASE. 8-step checklist, +16–17 delta.
|
||||
|
||||
38. **[design-done, pending review — `plans/designs/e38-sourceinfo.md` on `agent-e38-sourceinfo`] SourceInfo API** — 4 tests. Inline span-wrapper strategy (not side-channel dict) with compiler-entry unwrap. 4-commit plan.
|
||||
|
||||
39. **[design-done, pending review — `plans/designs/e39-webworker.md` on `hs-design-e39-webworker`] WebWorker plugin** — 1 test. Parser-only stub that errors with a link to upstream docs; no runtime, no mock Worker class. Hand-write the test (don't patch the generator). Single commit.
|
||||
|
||||
40. **[done +7 — d7244d1d] Fetch non-2xx / before-fetch event / real response object** — 7 tests. SX-dict Response wrapper `{:_hs-response :ok :status :url :_body :_json :_html}`; restructured `hs-fetch` that always fetches wrapper then converts by format; test-name-keyed `_fetchScripts`. 11-step checklist. Watch for regression on cluster-1 JSON unwrap.
|
||||
40. **[design-done, pending review — `plans/designs/e40-real-fetch.md` on `worktree-agent-a94612a4283eaa5e0`] Fetch non-2xx / before-fetch event / real response object** — 7 tests. SX-dict Response wrapper `{:_hs-response :ok :status :url :_body :_json :_html}`; restructured `hs-fetch` that always fetches wrapper then converts by format; test-name-keyed `_fetchScripts`. 11-step checklist. Watch for regression on cluster-1 JSON unwrap.
|
||||
|
||||
### Bucket F: generator translation gaps (after bucket A-D)
|
||||
|
||||
@@ -177,27 +175,6 @@ Many tests are `SKIP (untranslated)` because `tests/playwright/generate-sx-tests
|
||||
|
||||
## Progress log
|
||||
|
||||
### 2026-04-26 — Bucket F: array literal arg to JS fn (+1)
|
||||
- **da2e6b1b** — `HS Bucket F: array literal arg to JS fn fix (+1 test)`. Two-part fix: (a) `generate-sx-tests.py` `js_expr_to_sx` now translates `arr.reduce(fn, init)` → `(reduce fn init arr)`, `.map(fn)` → `(map fn arr)`, `.filter(fn)` → `(filter fn arr)` so SX list arguments work with JS array HO methods. (b) `host-call-fn` in `hs-run-filtered.js` adds `sxToJs` recursive converter that unwraps SX list `._type==='list'` to native JS arrays before calling native JS functions. Together these fix functionCalls "can pass an array literal as an argument". Suite hs-upstream-expressions/functionCalls: 8/12 (unchanged SKIP ratio). Test 597: 0/1 → 1/1. Smoke 0-195: 175/195 unchanged.
|
||||
|
||||
### 2026-04-26 — Bucket F: hs-make-object _order + assert= for dicts (+1)
|
||||
- **daea2808** — `HS Bucket F: fix hs-make-object _order + assert= for dicts (+1 test)`. Two-part fix: (a) `runtime.sx` `hs-make-object` no longer appends `_order` key to HS object literals — V8's native string-key insertion order is sufficient, and the hidden key was breaking structural equality. (b) `generate-sx-tests.py` `emit_eval` now detects when `expected_sx` contains `{` (dict syntax) and emits `assert-equal` (which uses `equal?` for deep structural equality) instead of `assert=` (which uses `=`, reference equality for dicts). Together these fix arrayLiteral "arrays containing objects work". Suite hs-upstream-expressions/arrayLiteral: 7/8 → 8/8. Smoke 0-195 unchanged at 175/195.
|
||||
|
||||
### 2026-04-26 — Bucket F: empty multi-element fix (+1)
|
||||
- **875e9ba3** — `HS: empty multi-element fix (+1 test)`. `empty .class` compiled `(empty-target (query ".class"))` through `hs-to-sx` → `(hs-empty-target! (hs-query-first ".class"))` which only emptied the first match. Fix: detect `(query ...)` target in the `empty-target` compiler case and emit `(for-each (fn (_el) (hs-empty-target! _el)) (hs-query-all sel))`, mirroring the `add-class` pattern. Suite hs-upstream-empty: 12/13 → 13/13. Smoke 0-195: 175/195 unchanged.
|
||||
|
||||
### 2026-04-26 — Bucket F: add CSS template interpolation (+1)
|
||||
- **5a76a040** — `HS: add CSS template interpolation fix (+1 test)`. `add {color: ${}{"red"}}` uses two consecutive brace groups: the empty `${}` marker followed by `{"red"}` for the actual value. The prior parser fix called `parse-expr` when already at the closing `}` of the empty group, returning nil. Fix: detect the empty-brace case (`brace-open` → immediately `brace-close`), skip it, then read the actual value from the next `{…}` block. Also handles normal `${expr}` correctly. Suite hs-upstream-add: 17/19 → 18/19. Smoke 0-195: 174/195 → 175/195.
|
||||
|
||||
### 2026-04-26 — cluster 36b call result binds to it (done +1)
|
||||
- **35f498ec** — `hs: call command binds result to it via emit-set (+1 test)`. `call X then put it into Y` compiled `call X` without `emit-set`, so `it` remained nil. Wrapped call-expr in `emit-set (quote the-result) ...` so both `it` and `the-result` are updated. Suite hs-upstream-call: 5/6 → 6/6. Smoke 0-195: 173/195 → 174/195.
|
||||
|
||||
### 2026-04-26 — cluster 7 put hyperscript reprocessing (done, final +1)
|
||||
- **247bd85c** — `hs: register promiseAString/promiseAnInt as sync test fixtures (+1 test)`. Upstream test "waits on promises" calls `promiseAString()` via window global. OCaml run_tests.ml registers these as NativeFns returning "foo"/"42" synchronously; JS runner had no equivalent. Added `globalThis.promiseAString = () => 'foo'` and `globalThis.promiseAnInt = () => 42` to hs-run-filtered.js. Suite hs-upstream-put: 37/38 → 38/38 (fully done). Smoke 0-195: 173/195 unchanged.
|
||||
|
||||
### 2026-04-26 — cluster 7 put hyperscript reprocessing (partial +3 more)
|
||||
- **d663c91f** — `hs: stop event propagation after each hs-on handler fires (+3 tests)`. Root cause: click events bubble from b1 (inside d1) to d1, causing d1's `on click put ...` handler to re-fire and replace the just-modified b1 with fresh content (text=40). Fix: `hs-on`'s wrapped handler now calls `event.stopPropagation()` after each handler runs, preventing the bubbled click from reaching ancestor HS listeners. Tests 1147/1149/1150 now pass. Suite hs-upstream-put: 34/38 → 37/38. Smoke 0-195: 173/195 unchanged. One test remains: "waits on promises" (async/Promise issue).
|
||||
|
||||
(Reverse chronological — newest at top.)
|
||||
|
||||
### 2026-04-25 — Bucket F: in-expression filter semantics (+1)
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because one or more lines are too long
@@ -19,7 +19,6 @@
|
||||
(define
|
||||
reserved
|
||||
(list
|
||||
(quote beingTold)
|
||||
(quote me)
|
||||
(quote it)
|
||||
(quote event)
|
||||
@@ -66,10 +65,7 @@
|
||||
(list (quote me))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list (quote beingTold) (quote me))
|
||||
(list (quote it) nil)
|
||||
(list (quote event) nil))
|
||||
(list (list (quote it) nil) (list (quote event) nil))
|
||||
guarded))))))))))
|
||||
|
||||
;; ── Activate a single element ───────────────────────────────────
|
||||
@@ -77,51 +73,26 @@
|
||||
;; Marks the element to avoid double-activation.
|
||||
|
||||
(define
|
||||
hs-register-scripts!
|
||||
hs-activate!
|
||||
(fn
|
||||
()
|
||||
(for-each
|
||||
(fn
|
||||
(script)
|
||||
(el)
|
||||
(let
|
||||
((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script")))
|
||||
(when
|
||||
(and src (not (= src prev)))
|
||||
(when
|
||||
(not (dom-get-data script "hs-script-loaded"))
|
||||
(let
|
||||
((src (host-get script "innerHTML")))
|
||||
(when
|
||||
(and src (not (= src "")))
|
||||
(guard
|
||||
(_e (true nil))
|
||||
(eval-expr-cek (hs-to-sx-from-source src)))
|
||||
(dom-set-data script "hs-script-loaded" true)))))
|
||||
(hs-query-all "script[type=text/hyperscript]"))))
|
||||
(dom-dispatch el "hyperscript:before:init" nil)
|
||||
(hs-log-event! "hyperscript:init")
|
||||
(dom-set-data el "hs-script" src)
|
||||
(dom-set-data el "hs-active" true)
|
||||
(dom-set-attr el "data-hyperscript-powered" "true")
|
||||
(let ((handler (hs-handler src))) (handler el))
|
||||
(dom-dispatch el "hyperscript:after:init" nil))))))
|
||||
|
||||
;; ── Boot: scan entire document ──────────────────────────────────
|
||||
;; Called once at page load. Finds all elements with _ attribute,
|
||||
;; compiles their hyperscript, and activates them.
|
||||
|
||||
(define
|
||||
hs-activate!
|
||||
(fn
|
||||
(el)
|
||||
(do
|
||||
(hs-register-scripts!)
|
||||
(let
|
||||
((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script")))
|
||||
(when
|
||||
(and src (not (= src prev)))
|
||||
(when
|
||||
(dom-dispatch el "hyperscript:before:init" nil)
|
||||
(hs-log-event! "hyperscript:init")
|
||||
(dom-set-data el "hs-script" src)
|
||||
(dom-set-data el "hs-active" true)
|
||||
(dom-set-attr el "data-hyperscript-powered" "true")
|
||||
(let ((handler (hs-handler src))) (handler el))
|
||||
(dom-dispatch el "hyperscript:after:init" nil)))))))
|
||||
|
||||
;; ── Boot subtree: for dynamic content ───────────────────────────
|
||||
;; Called after HTMX swaps or dynamic DOM insertion.
|
||||
;; Only activates elements within the given root.
|
||||
|
||||
(define
|
||||
hs-deactivate!
|
||||
(fn
|
||||
@@ -133,6 +104,10 @@
|
||||
(dom-set-data el "hs-active" false)
|
||||
(dom-set-data el "hs-script" nil))))
|
||||
|
||||
;; ── Boot subtree: for dynamic content ───────────────────────────
|
||||
;; Called after HTMX swaps or dynamic DOM insertion.
|
||||
;; Only activates elements within the given root.
|
||||
|
||||
(define
|
||||
hs-boot!
|
||||
(fn
|
||||
|
||||
@@ -9,11 +9,7 @@
|
||||
(fn
|
||||
(tokens src)
|
||||
(let
|
||||
((tokens (filter (fn (t) (not (= (get t "type") "whitespace"))) tokens))
|
||||
(p 0)
|
||||
(tok-len
|
||||
(len
|
||||
(filter (fn (t) (not (= (get t "type") "whitespace"))) tokens))))
|
||||
((p 0) (tok-len (len tokens)))
|
||||
(define tp (fn () (if (< p tok-len) (nth tokens p) nil)))
|
||||
(define
|
||||
tp-type
|
||||
@@ -25,16 +21,6 @@
|
||||
adv!
|
||||
(fn () (let ((t (nth tokens p))) (set! p (+ p 1)) t)))
|
||||
(define at-end? (fn () (or (>= p tok-len) (= (tp-type) "eof"))))
|
||||
(define cur-start (fn () (if (< p tok-len) (get (tp) "pos") 0)))
|
||||
(define cur-line (fn () (if (< p tok-len) (get (tp) "line") 1)))
|
||||
(define
|
||||
prev-end
|
||||
(fn () (if (> p 0) (get (nth tokens (- p 1)) "end") 0)))
|
||||
(define
|
||||
hs-ast-wrap
|
||||
(fn
|
||||
(raw kind start end-pos line fields)
|
||||
(if hs-span-mode {:children raw :end end-pos :kind kind :line line :src src :start start :hs-ast true :fields fields} raw)))
|
||||
(define
|
||||
match-kw
|
||||
(fn
|
||||
@@ -83,40 +69,19 @@
|
||||
parse-prop-chain
|
||||
(fn
|
||||
(base)
|
||||
(let
|
||||
((base-start (if (and (dict? base) (get base :hs-ast)) (get base :start) (cur-start)))
|
||||
(base-line
|
||||
(if
|
||||
(and (dict? base) (get base :hs-ast))
|
||||
(get base :line)
|
||||
(cur-line))))
|
||||
(if
|
||||
(and (= (tp-type) "class") (not (at-end?)))
|
||||
(let
|
||||
((prop (tp-val)))
|
||||
(do
|
||||
(adv!)
|
||||
(parse-prop-chain (list (make-symbol ".") base prop))))
|
||||
(if
|
||||
(and (= (tp-type) "class") (not (at-end?)))
|
||||
(= (tp-type) "paren-open")
|
||||
(let
|
||||
((prop (tp-val)))
|
||||
(do
|
||||
(adv!)
|
||||
(parse-prop-chain
|
||||
(hs-ast-wrap
|
||||
(list (make-symbol ".") base prop)
|
||||
"member"
|
||||
base-start
|
||||
(prev-end)
|
||||
base-line
|
||||
{:root base}))))
|
||||
(if
|
||||
(= (tp-type) "paren-open")
|
||||
(let
|
||||
((args (parse-call-args)))
|
||||
(parse-prop-chain
|
||||
(hs-ast-wrap
|
||||
(list (quote method-call) base args)
|
||||
"call"
|
||||
base-start
|
||||
(prev-end)
|
||||
base-line
|
||||
{:root base})))
|
||||
base)))))
|
||||
((args (parse-call-args)))
|
||||
(parse-prop-chain (list (quote method-call) base args)))
|
||||
base))))
|
||||
(define
|
||||
parse-trav
|
||||
(fn
|
||||
@@ -127,23 +92,19 @@
|
||||
((and (= kind (quote closest)) (= typ "ident") (= val "parent"))
|
||||
(do (adv!) (parse-trav (quote closest-parent))))
|
||||
((= typ "selector")
|
||||
(do (adv!) (list kind val (list (quote beingTold)))))
|
||||
(do (adv!) (list kind val (list (quote me)))))
|
||||
((= typ "class")
|
||||
(do
|
||||
(adv!)
|
||||
(list kind (str "." val) (list (quote beingTold)))))
|
||||
(do (adv!) (list kind (str "." val) (list (quote me)))))
|
||||
((= typ "id")
|
||||
(do
|
||||
(adv!)
|
||||
(list kind (str "#" val) (list (quote beingTold)))))
|
||||
(do (adv!) (list kind (str "#" val) (list (quote me)))))
|
||||
((= typ "attr")
|
||||
(do
|
||||
(adv!)
|
||||
(list
|
||||
(quote attr)
|
||||
val
|
||||
(list kind (str "[" val "]") (list (quote beingTold))))))
|
||||
(true (list kind "*" (list (quote beingTold))))))))
|
||||
(list kind (str "[" val "]") (list (quote me))))))
|
||||
(true (list kind "*" (list (quote me))))))))
|
||||
(define
|
||||
parse-pos-kw
|
||||
(fn
|
||||
@@ -163,24 +124,8 @@
|
||||
(let
|
||||
((typ (tp-type)) (val (tp-val)))
|
||||
(cond
|
||||
((= typ "number")
|
||||
(let
|
||||
((s (cur-start)) (l (cur-line)))
|
||||
(do
|
||||
(adv!)
|
||||
(hs-ast-wrap
|
||||
(parse-dur val)
|
||||
"number"
|
||||
s
|
||||
(prev-end)
|
||||
l
|
||||
{}))))
|
||||
((= typ "string")
|
||||
(let
|
||||
((s (cur-start)) (l (cur-line)))
|
||||
(do
|
||||
(adv!)
|
||||
(hs-ast-wrap val "string" s (prev-end) l {}))))
|
||||
((= typ "number") (do (adv!) (parse-dur val)))
|
||||
((= typ "string") (do (adv!) val))
|
||||
((= typ "template") (do (adv!) (list (quote template) val)))
|
||||
((and (= typ "keyword") (= val "true")) (do (adv!) true))
|
||||
((and (= typ "keyword") (= val "false")) (do (adv!) false))
|
||||
@@ -245,51 +190,26 @@
|
||||
((and (= typ "keyword") (= val "last"))
|
||||
(do (adv!) (parse-pos-kw (quote last))))
|
||||
((= typ "id")
|
||||
(let
|
||||
((s (cur-start)) (l (cur-line)))
|
||||
(do
|
||||
(adv!)
|
||||
(hs-ast-wrap
|
||||
(list (quote query) (str "#" val))
|
||||
"selector"
|
||||
s
|
||||
(prev-end)
|
||||
l
|
||||
{}))))
|
||||
(do (adv!) (list (quote query) (str "#" val))))
|
||||
((= typ "selector")
|
||||
(let
|
||||
((s (cur-start)) (l (cur-line)))
|
||||
(do
|
||||
(adv!)
|
||||
(hs-ast-wrap
|
||||
(if
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "in"))
|
||||
(do
|
||||
(adv!)
|
||||
(list
|
||||
(quote query-scoped)
|
||||
val
|
||||
(parse-cmp
|
||||
(parse-arith (parse-poss (parse-atom))))))
|
||||
(list (quote query) val))
|
||||
"selector"
|
||||
s
|
||||
(prev-end)
|
||||
l
|
||||
{}))))
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "in"))
|
||||
(do
|
||||
(adv!)
|
||||
(list
|
||||
(quote query-scoped)
|
||||
val
|
||||
(parse-cmp (parse-arith (parse-poss (parse-atom))))))
|
||||
(list (quote query) val))))
|
||||
((= typ "attr")
|
||||
(do
|
||||
(adv!)
|
||||
(list (quote attr) val (list (quote beingTold)))))
|
||||
(do (adv!) (list (quote attr) val (list (quote me)))))
|
||||
((= typ "style")
|
||||
(do
|
||||
(adv!)
|
||||
(list (quote style) val (list (quote beingTold)))))
|
||||
(do (adv!) (list (quote style) val (list (quote me)))))
|
||||
((= typ "local") (do (adv!) (list (quote local) val)))
|
||||
((= typ "hat")
|
||||
(do
|
||||
(adv!)
|
||||
(list (quote dom-ref) val (list (quote beingTold)))))
|
||||
(do (adv!) (list (quote dom-ref) val (list (quote me)))))
|
||||
((and (= typ "keyword") (= val "dom"))
|
||||
(do
|
||||
(adv!)
|
||||
@@ -297,31 +217,10 @@
|
||||
((name (tp-val)))
|
||||
(do
|
||||
(adv!)
|
||||
(list (quote dom-ref) name (list (quote beingTold)))))))
|
||||
(list (quote dom-ref) name (list (quote me)))))))
|
||||
((= typ "class")
|
||||
(let
|
||||
((s (cur-start)) (l (cur-line)))
|
||||
(do
|
||||
(adv!)
|
||||
(hs-ast-wrap
|
||||
(list (quote query) (str "." val))
|
||||
"selector"
|
||||
s
|
||||
(prev-end)
|
||||
l
|
||||
{}))))
|
||||
((= typ "ident")
|
||||
(let
|
||||
((s (cur-start)) (l (cur-line)))
|
||||
(do
|
||||
(adv!)
|
||||
(hs-ast-wrap
|
||||
(list (quote ref) val)
|
||||
"ref"
|
||||
s
|
||||
(prev-end)
|
||||
l
|
||||
{}))))
|
||||
(do (adv!) (list (quote query) (str "." val))))
|
||||
((= typ "ident") (do (adv!) (list (quote ref) val)))
|
||||
((= typ "paren-open")
|
||||
(do
|
||||
(adv!)
|
||||
@@ -429,8 +328,6 @@
|
||||
(let
|
||||
((name val) (args (parse-call-args)))
|
||||
(cons (quote call) (cons (list (quote ref) name) args)))))
|
||||
((= typ "keyword")
|
||||
(do (adv!) (list (quote ref) val)))
|
||||
(true nil)))))
|
||||
(define
|
||||
parse-poss
|
||||
@@ -440,14 +337,6 @@
|
||||
((and (= (tp-type) "op") (= (tp-val) "'s"))
|
||||
(do (adv!) (parse-poss-tail obj)))
|
||||
((= (tp-type) "class") (parse-prop-chain obj))
|
||||
((= (tp-type) "dot")
|
||||
(do
|
||||
(adv!)
|
||||
(let ((typ2 (tp-type)) (val2 (tp-val)))
|
||||
(if
|
||||
(or (= typ2 "ident") (= typ2 "keyword"))
|
||||
(do (adv!) (parse-poss (list (make-symbol ".") obj val2)))
|
||||
obj))))
|
||||
((= (tp-type) "paren-open")
|
||||
(let
|
||||
((args (parse-call-args)))
|
||||
@@ -574,9 +463,7 @@
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote eq-ignore-case) left right)))
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote hs-id=) left right)))))))
|
||||
(list (quote not) (list (quote =) left right)))))))
|
||||
((match-kw "empty") (list (quote empty?) left))
|
||||
((match-kw "less")
|
||||
(do
|
||||
@@ -1006,7 +893,7 @@
|
||||
(collect-classes!))))
|
||||
(collect-classes!)
|
||||
(let
|
||||
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold)))))
|
||||
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
|
||||
(let
|
||||
((when-clause (if (match-kw "when") (parse-expr) nil)))
|
||||
(if
|
||||
@@ -1035,7 +922,7 @@
|
||||
(get (adv!) "value")
|
||||
(parse-expr))))
|
||||
(let
|
||||
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold)))))
|
||||
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
|
||||
(list (quote set-style) prop value tgt))))
|
||||
((= (tp-type) "brace-open")
|
||||
(do
|
||||
@@ -1054,16 +941,14 @@
|
||||
((prop (get (adv!) "value")))
|
||||
(when (= (tp-type) "colon") (adv!))
|
||||
(let
|
||||
((val (if (and (= (tp-type) "ident") (= (tp-val) "$")) (do (adv!) (when (= (tp-type) "brace-open") (adv!)) (if (= (tp-type) "brace-close") (do (adv!) (if (= (tp-type) "brace-open") (do (adv!) (let ((inner (parse-expr))) (when (= (tp-type) "brace-close") (adv!)) inner)) "")) (let ((expr (parse-expr))) (when (= (tp-type) "brace-close") (adv!)) expr))) (get (adv!) "value"))))
|
||||
((val (tp-val)))
|
||||
(adv!)
|
||||
(set! pairs (cons (list prop val) pairs))
|
||||
(when
|
||||
(and (= (tp-type) "op") (= (tp-val) ";"))
|
||||
(adv!))
|
||||
(collect-pairs!))))))
|
||||
(collect-pairs!)
|
||||
(when (= (tp-type) "brace-close") (adv!))
|
||||
(let
|
||||
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold)))))
|
||||
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
|
||||
(list (quote set-styles) (reverse pairs) tgt)))))
|
||||
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
|
||||
(do
|
||||
@@ -1075,7 +960,7 @@
|
||||
((attr-val (parse-expr)))
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "to" (list (quote beingTold)))))
|
||||
((tgt (parse-tgt-kw "to" (list (quote me)))))
|
||||
(let
|
||||
((when-clause (if (match-kw "when") (parse-expr) nil)))
|
||||
(if
|
||||
@@ -1093,7 +978,7 @@
|
||||
(let
|
||||
((attr-val (if (and (= (tp-type) "op") (= (tp-val) "=")) (do (adv!) (parse-expr)) "")))
|
||||
(let
|
||||
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold)))))
|
||||
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
|
||||
(let
|
||||
((when-clause (if (match-kw "when") (parse-expr) nil)))
|
||||
(if
|
||||
@@ -1134,23 +1019,18 @@
|
||||
(collect-classes!))))
|
||||
(collect-classes!)
|
||||
(let
|
||||
((tgt (if (match-kw "from") (parse-expr) (list (quote beingTold)))))
|
||||
(let
|
||||
((when-clause (if (match-kw "when") (parse-expr) nil)))
|
||||
(if
|
||||
(empty? extra-classes)
|
||||
(if
|
||||
when-clause
|
||||
(list (quote remove-class-when) cls tgt when-clause)
|
||||
(list (quote remove-class) cls tgt))
|
||||
(cons
|
||||
(quote multi-remove-class)
|
||||
(cons tgt (cons cls extra-classes))))))))
|
||||
((tgt (if (match-kw "from") (parse-expr) (list (quote me)))))
|
||||
(if
|
||||
(empty? extra-classes)
|
||||
(list (quote remove-class) cls tgt)
|
||||
(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 beingTold)))))
|
||||
((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
|
||||
@@ -1212,7 +1092,7 @@
|
||||
(let
|
||||
((cls2 (do (let ((v (tp-val))) (adv!) v))))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote beingTold)))))
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(list (quote toggle-between) cls1 cls2 tgt)))
|
||||
nil)))
|
||||
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
|
||||
@@ -1237,7 +1117,7 @@
|
||||
((v2 (parse-expr)))
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote beingTold)))))
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(if
|
||||
(= n1 n2)
|
||||
(list
|
||||
@@ -1271,7 +1151,7 @@
|
||||
(let
|
||||
((extra-classes (collect-classes (list))))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote beingTold)))))
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(cond
|
||||
((> (len extra-classes) 0)
|
||||
(list
|
||||
@@ -1300,7 +1180,7 @@
|
||||
(let
|
||||
((prop (get (adv!) "value")))
|
||||
(let
|
||||
((tgt (if (match-kw "of") (parse-expr) (list (quote beingTold)))))
|
||||
((tgt (if (match-kw "of") (parse-expr) (list (quote me)))))
|
||||
(if
|
||||
(match-kw "between")
|
||||
(let
|
||||
@@ -1371,7 +1251,7 @@
|
||||
(let
|
||||
((attr-name (get (adv!) "value")))
|
||||
(let
|
||||
((tgt (if (match-kw "on") (parse-expr) (list (quote beingTold)))))
|
||||
((tgt (if (match-kw "on") (parse-expr) (list (quote me)))))
|
||||
(if
|
||||
(match-kw "between")
|
||||
(let
|
||||
@@ -1396,7 +1276,7 @@
|
||||
((attr-val (parse-expr)))
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote beingTold)))))
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(list (quote toggle-attr-val) attr-name attr-val tgt))))))
|
||||
((and (= (tp-type) "keyword") (= (tp-val) "my"))
|
||||
(do
|
||||
@@ -1475,9 +1355,7 @@
|
||||
((match-kw "to")
|
||||
(let
|
||||
((value (parse-expr)))
|
||||
(if (and (list? tgt) (= (first tgt) (quote query)))
|
||||
(list (quote set-el!) tgt value)
|
||||
(list (quote set!) tgt value))))
|
||||
(list (quote set!) tgt value)))
|
||||
((match-kw "on")
|
||||
(let
|
||||
((target (parse-expr)))
|
||||
@@ -1626,7 +1504,7 @@
|
||||
(let
|
||||
((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil)))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "to" (list (quote beingTold)))))
|
||||
((tgt (parse-tgt-kw "to" (list (quote me)))))
|
||||
(if
|
||||
dtl
|
||||
(list (quote send) name dtl tgt)
|
||||
@@ -1640,7 +1518,7 @@
|
||||
(let
|
||||
((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil)))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote beingTold)))))
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(if
|
||||
dtl
|
||||
(list (quote trigger) name dtl tgt)
|
||||
@@ -1679,7 +1557,7 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show") (= (tp-val) "on"))) (list (quote beingTold))) (true (parse-expr)))))
|
||||
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show") (= (tp-val) "on"))) (list (quote me))) (true (parse-expr)))))
|
||||
(let
|
||||
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display")))
|
||||
(let
|
||||
@@ -1690,7 +1568,7 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show") (= (tp-val) "on"))) (list (quote beingTold))) (true (parse-expr)))))
|
||||
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show") (= (tp-val) "on"))) (list (quote me))) (true (parse-expr)))))
|
||||
(let
|
||||
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display")))
|
||||
(let
|
||||
@@ -1716,7 +1594,7 @@
|
||||
((from-val (if (match-kw "from") (let ((v (parse-atom))) (if (and v (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v)) nil)))
|
||||
(expect-kw! "to")
|
||||
(let
|
||||
((value (if (and (= (tp-type) "ident") (= (tp-val) "initial")) (do (adv!) "initial") (let ((v (parse-atom))) (if (and v (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v)))))
|
||||
((value (let ((v (parse-atom))) (if (and v (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v))))
|
||||
(let
|
||||
((dur (if (match-kw "over") (let ((v (parse-atom))) (if (and (number? v) (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v)) nil)))
|
||||
(let
|
||||
@@ -1806,7 +1684,7 @@
|
||||
((url (if (and (= (tp-type) "keyword") (= (tp-val) "from")) (do (adv!) (parse-arith (parse-poss (parse-atom)))) nil)))
|
||||
(list (quote fetch-gql) gql-source url))))
|
||||
(let
|
||||
((url-atom (if (and (= (tp-type) "op") (= (tp-val) "/")) (do (adv!) (let ((path-parts (list "/"))) (define read-path (fn () (when (and (not (at-end?)) (or (and (= (tp-type) "ident") (not (string-contains? (tp-val) "'"))) (= (tp-type) "op") (= (tp-type) "dot") (= (tp-type) "number"))) (append! path-parts (tp-val)) (adv!) (read-path)))) (read-path) (join "" path-parts))) (parse-atom))))
|
||||
((url-atom (if (and (= (tp-type) "op") (= (tp-val) "/")) (do (adv!) (let ((path-parts (list "/"))) (define read-path (fn () (when (and (not (at-end?)) (or (= (tp-type) "ident") (= (tp-type) "op") (= (tp-type) "dot") (= (tp-type) "number"))) (append! path-parts (tp-val)) (adv!) (read-path)))) (read-path) (join "" path-parts))) (parse-atom))))
|
||||
(let
|
||||
((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom)))))
|
||||
(let
|
||||
@@ -1822,9 +1700,7 @@
|
||||
((fmt-after (if (and (not fmt-before) (match-kw "as")) (do (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (or (= (tp-val) "an") (= (tp-val) "a"))) (adv!)) (let ((f (tp-val))) (adv!) f)) nil)))
|
||||
(let
|
||||
((fmt (or fmt-before fmt-after "text")))
|
||||
(let
|
||||
((do-not-throw (cond ((and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "do")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "not")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw")) (do (adv!) true) false)) false))) ((and (= (tp-type) "ident") (= (tp-val) "don't")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw")) (do (adv!) true) false))) (true false))))
|
||||
(list (quote fetch) url fmt do-not-throw))))))))))
|
||||
(list (quote fetch) url fmt)))))))))
|
||||
(define
|
||||
parse-call-args
|
||||
(fn
|
||||
@@ -2145,21 +2021,7 @@
|
||||
((op (cond ((= val "+") (quote +)) ((= val "-") (quote -)) ((= val "*") (quote *)) ((= val "/") (quote /)) ((or (= val "%") (= val "mod")) (make-symbol "%")))))
|
||||
(let
|
||||
((right (let ((a (parse-atom))) (if (nil? a) a (parse-poss a)))))
|
||||
(let
|
||||
((lhs-start (if (and (dict? left) (get left :hs-ast)) (get left :start) 0))
|
||||
(lhs-line
|
||||
(if
|
||||
(and (dict? left) (get left :hs-ast))
|
||||
(get left :line)
|
||||
1)))
|
||||
(parse-arith
|
||||
(hs-ast-wrap
|
||||
(list op left right)
|
||||
"arith"
|
||||
lhs-start
|
||||
(prev-end)
|
||||
lhs-line
|
||||
{:rhs right :lhs left}))))))
|
||||
(parse-arith (list op left right)))))
|
||||
left))))
|
||||
(define
|
||||
parse-the-expr
|
||||
@@ -2174,21 +2036,21 @@
|
||||
(if
|
||||
(match-kw "of")
|
||||
(list (quote style) val (parse-expr))
|
||||
(list (quote style) val (list (quote beingTold))))))
|
||||
(list (quote style) val (list (quote me))))))
|
||||
((= typ "attr")
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(match-kw "of")
|
||||
(list (quote attr) val (parse-expr))
|
||||
(list (quote attr) val (list (quote beingTold))))))
|
||||
(list (quote attr) val (list (quote me))))))
|
||||
((= typ "class")
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(match-kw "of")
|
||||
(list (quote has-class?) (parse-expr) val)
|
||||
(list (quote has-class?) (list (quote beingTold)) val))))
|
||||
(list (quote has-class?) (list (quote me)) val))))
|
||||
((= typ "selector")
|
||||
(do
|
||||
(adv!)
|
||||
@@ -2336,15 +2198,13 @@
|
||||
()
|
||||
(let
|
||||
((tgt (parse-expr)))
|
||||
(list
|
||||
(quote measure)
|
||||
(if (nil? tgt) (list (quote beingTold)) tgt)))))
|
||||
(list (quote measure) (if (nil? tgt) (list (quote me)) tgt)))))
|
||||
(define
|
||||
parse-scroll-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote beingTold)) (parse-expr))))
|
||||
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote me)) (parse-expr))))
|
||||
(let
|
||||
((pos (cond ((match-kw "top") "top") ((match-kw "bottom") "bottom") ((match-kw "left") "left") ((match-kw "right") "right") (true "top"))))
|
||||
(list (quote scroll!) tgt pos)))))
|
||||
@@ -2353,14 +2213,14 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote beingTold)) (parse-expr))))
|
||||
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote me)) (parse-expr))))
|
||||
(list (quote select!) tgt))))
|
||||
(define
|
||||
parse-reset-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote beingTold)) (parse-expr))))
|
||||
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote me)) (parse-expr))))
|
||||
(list (quote reset!) tgt))))
|
||||
(define
|
||||
parse-default-cmd
|
||||
@@ -2385,7 +2245,7 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr)))))
|
||||
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
|
||||
(list (quote focus!) tgt))))
|
||||
(define
|
||||
parse-feat-body
|
||||
@@ -2499,7 +2359,7 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((target (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr)))))
|
||||
((target (cond ((at-end?) (list (quote ref) "me")) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote ref) "me")) (true (parse-expr)))))
|
||||
(list (quote empty-target) target))))
|
||||
(define
|
||||
parse-swap-cmd
|
||||
@@ -2524,42 +2384,15 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((target (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr)))))
|
||||
((target (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
|
||||
(list (quote open-element) target))))
|
||||
(define
|
||||
parse-close-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((target (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr)))))
|
||||
((target (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
|
||||
(list (quote close-element) target))))
|
||||
(define
|
||||
parse-js-block
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((params (if (= (tp-type) "paren-open") (do (adv!) (define collect-params! (fn (acc) (cond ((or (at-end?) (= (tp-type) "paren-close")) (do (when (= (tp-type) "paren-close") (adv!)) acc)) ((= (tp-type) "comma") (do (adv!) (collect-params! acc))) (true (let ((pname (tp-val))) (do (adv!) (collect-params! (append acc pname)))))))) (collect-params! (list))) (list))))
|
||||
(let
|
||||
((js-start (cur-start)))
|
||||
(define
|
||||
skip-to-end!
|
||||
(fn
|
||||
()
|
||||
(if
|
||||
(or
|
||||
(at-end?)
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "end")))
|
||||
nil
|
||||
(do (adv!) (skip-to-end!)))))
|
||||
(skip-to-end!)
|
||||
(let
|
||||
((js-end (cur-start)))
|
||||
(let
|
||||
((js-src (substring src js-start js-end)))
|
||||
(when
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "end"))
|
||||
(adv!))
|
||||
(list (quote js-block) params js-src)))))))
|
||||
(define
|
||||
parse-cmd
|
||||
(fn
|
||||
@@ -2588,21 +2421,7 @@
|
||||
((and (= typ "keyword") (= val "put"))
|
||||
(do (adv!) (parse-put-cmd)))
|
||||
((and (= typ "keyword") (= val "if"))
|
||||
(let
|
||||
((s (cur-start)) (l (cur-line)))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((r (parse-if-cmd)))
|
||||
(let
|
||||
((tb (if (and (list? r) (> (len r) 2)) (nth r 2) nil)))
|
||||
(hs-ast-wrap
|
||||
r
|
||||
"if"
|
||||
s
|
||||
(prev-end)
|
||||
l
|
||||
(if tb {:true-branch (if (and (list? tb) (= (first tb) (quote do))) (nth tb 1) tb)} {})))))))
|
||||
(do (adv!) (parse-if-cmd)))
|
||||
((and (= typ "keyword") (= val "wait"))
|
||||
(do (adv!) (parse-wait-cmd)))
|
||||
((and (= typ "keyword") (= val "send"))
|
||||
@@ -2610,17 +2429,7 @@
|
||||
((and (= typ "keyword") (= val "trigger"))
|
||||
(do (adv!) (parse-trigger-cmd)))
|
||||
((and (= typ "keyword") (= val "log"))
|
||||
(let
|
||||
((s (cur-start)) (l (cur-line)))
|
||||
(do
|
||||
(adv!)
|
||||
(hs-ast-wrap
|
||||
(parse-log-cmd)
|
||||
"cmd"
|
||||
s
|
||||
(prev-end)
|
||||
l
|
||||
{}))))
|
||||
(do (adv!) (parse-log-cmd)))
|
||||
((and (= typ "keyword") (= val "increment"))
|
||||
(do (adv!) (parse-inc-cmd)))
|
||||
((and (= typ "keyword") (= val "decrement"))
|
||||
@@ -2660,17 +2469,7 @@
|
||||
((and (= typ "keyword") (= val "tell"))
|
||||
(do (adv!) (parse-tell-cmd)))
|
||||
((and (= typ "keyword") (= val "for"))
|
||||
(let
|
||||
((s (cur-start)) (l (cur-line)))
|
||||
(do
|
||||
(adv!)
|
||||
(hs-ast-wrap
|
||||
(parse-for-cmd)
|
||||
"cmd"
|
||||
s
|
||||
(prev-end)
|
||||
l
|
||||
{}))))
|
||||
(do (adv!) (parse-for-cmd)))
|
||||
((and (= typ "keyword") (= val "make"))
|
||||
(do (adv!) (parse-make-cmd)))
|
||||
((and (= typ "keyword") (= val "install"))
|
||||
@@ -2709,18 +2508,6 @@
|
||||
(do (adv!) (list (quote continue))))
|
||||
((and (= typ "keyword") (or (= val "exit") (= val "halt")))
|
||||
(do (adv!) (list (quote exit))))
|
||||
((and (= typ "keyword") (= val "js"))
|
||||
(do (adv!) (parse-js-block)))
|
||||
((and (= typ "keyword") (= val "start"))
|
||||
(do
|
||||
(adv!)
|
||||
(expect-kw! "view")
|
||||
(expect-kw! "transition")
|
||||
(let ((using (if (match-kw "using") (parse-expr) nil)))
|
||||
(match-kw "then")
|
||||
(let ((body (parse-cmd-list)))
|
||||
(match-kw "end")
|
||||
(list (quote view-transition!) using body)))))
|
||||
(true (parse-expr))))))
|
||||
(define
|
||||
parse-cmd-list
|
||||
@@ -2776,71 +2563,41 @@
|
||||
(= v "close")
|
||||
(= v "pick")
|
||||
(= v "ask")
|
||||
(= v "answer")
|
||||
(= v "js")
|
||||
(= v "start"))))
|
||||
(= v "answer"))))
|
||||
(define
|
||||
cl-collect
|
||||
(fn
|
||||
(acc)
|
||||
(do
|
||||
(when
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "then"))
|
||||
(adv!))
|
||||
(let
|
||||
((cmd (parse-cmd)))
|
||||
(if
|
||||
(nil? cmd)
|
||||
acc
|
||||
(let
|
||||
((acc2 (append acc (list cmd))))
|
||||
(cond
|
||||
((match-kw "unless")
|
||||
(let
|
||||
((cnd (parse-expr)))
|
||||
(cl-collect
|
||||
(append
|
||||
acc
|
||||
(list
|
||||
(list
|
||||
(quote if)
|
||||
(list (quote no) cnd)
|
||||
cmd))))))
|
||||
((match-kw "then")
|
||||
(cl-collect (append acc2 (list (quote __then__)))))
|
||||
((or (and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val))) (= (tp-type) "paren-open"))
|
||||
(cl-collect acc2))
|
||||
(true acc2))))))))
|
||||
(let
|
||||
((cmd (parse-cmd)))
|
||||
(if
|
||||
(nil? cmd)
|
||||
acc
|
||||
(let
|
||||
((acc2 (append acc (list cmd))))
|
||||
(cond
|
||||
((match-kw "unless")
|
||||
(let
|
||||
((cnd (parse-expr)))
|
||||
(cl-collect
|
||||
(append
|
||||
acc
|
||||
(list
|
||||
(list (quote if) (list (quote no) cnd) cmd))))))
|
||||
((match-kw "then")
|
||||
(cl-collect (append acc2 (list (quote __then__)))))
|
||||
((or (and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val))) (= (tp-type) "paren-open"))
|
||||
(cl-collect acc2))
|
||||
(true acc2)))))))
|
||||
(let
|
||||
((cmds (cl-collect (list))))
|
||||
(define
|
||||
link-next-cmds
|
||||
(fn
|
||||
(cmds-list)
|
||||
(define
|
||||
loop
|
||||
(fn
|
||||
(i)
|
||||
(when
|
||||
(< i (- (len cmds-list) 1))
|
||||
(let
|
||||
((cur-node (nth cmds-list i))
|
||||
(nxt-node (nth cmds-list (+ i 1))))
|
||||
(when
|
||||
(and (dict? cur-node) (get cur-node :hs-ast))
|
||||
(dict-set! (get cur-node :fields) "next" nxt-node)))
|
||||
(loop (+ i 1)))))
|
||||
(loop 0)
|
||||
cmds-list))
|
||||
(let
|
||||
((linked (if hs-span-mode (link-next-cmds cmds) cmds)))
|
||||
(cond
|
||||
((= (len linked) 0) nil)
|
||||
((= (len linked) 1) (first linked))
|
||||
(true
|
||||
(cons
|
||||
(quote do)
|
||||
(filter (fn (c) (not (= c (quote __then__)))) linked))))))))
|
||||
(cond
|
||||
((= (len cmds) 0) nil)
|
||||
((= (len cmds) 1) (first cmds))
|
||||
(true
|
||||
(cons
|
||||
(quote do)
|
||||
(filter (fn (c) (not (= c (quote __then__)))) cmds)))))))
|
||||
(define
|
||||
parse-on-feat
|
||||
(fn
|
||||
@@ -2882,7 +2639,6 @@
|
||||
(true nil))))
|
||||
(true nil))))
|
||||
(consume-having!)
|
||||
(when (and (= (tp-type) "keyword") (= (tp-val) "queue")) (do (adv!) (adv!)))
|
||||
(let
|
||||
((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
|
||||
(let
|
||||
@@ -2973,6 +2729,63 @@
|
||||
(match-kw "end")
|
||||
(list (quote when-feat-no-op)))))
|
||||
(do (pwf-skip) (match-kw "end") (list (quote when-feat-no-op))))))
|
||||
(define
|
||||
parse-socket-feat
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((seg0 (tp-val)))
|
||||
(adv!)
|
||||
(define
|
||||
collect-segs
|
||||
(fn
|
||||
(acc)
|
||||
(if
|
||||
(= (tp-type) "class")
|
||||
(let
|
||||
((seg (tp-val)))
|
||||
(adv!)
|
||||
(collect-segs (append acc (list seg))))
|
||||
acc)))
|
||||
(let
|
||||
((name-path (collect-segs (list seg0))))
|
||||
(define
|
||||
url-cont?
|
||||
(fn
|
||||
()
|
||||
(or
|
||||
(= (tp-type) "ident")
|
||||
(= (tp-type) "number")
|
||||
(= (tp-type) "op")
|
||||
(= (tp-type) "colon")
|
||||
(= (tp-type) "dot")
|
||||
(and
|
||||
(= (tp-type) "keyword")
|
||||
(not
|
||||
(or
|
||||
(= (tp-val) "end")
|
||||
(= (tp-val) "with")
|
||||
(= (tp-val) "on")
|
||||
(= (tp-val) "as")))))))
|
||||
(define
|
||||
collect-url
|
||||
(fn
|
||||
(parts)
|
||||
(if
|
||||
(and (not (at-end?)) (url-cont?))
|
||||
(let
|
||||
((v (tp-val)))
|
||||
(adv!)
|
||||
(collect-url (append parts (list v))))
|
||||
(join "" parts))))
|
||||
(let
|
||||
((url (cond ((and (= (tp-type) "op") (= (tp-val) "/")) (do (adv!) (collect-url (list "/")))) ((= (tp-type) "ident") (let ((scheme (tp-val))) (adv!) (if (= (tp-type) "colon") (collect-url (list scheme)) (parse-arith (parse-poss (list (quote ref) scheme)))))) (true (parse-atom)))))
|
||||
(let
|
||||
((timeout-ms (if (match-kw "with") (do (adv!) (parse-expr)) nil)))
|
||||
(let
|
||||
((on-msg (if (match-kw "on") (do (adv!) (let ((json? (if (match-kw "as") (do (adv!) true) false))) (let ((body (parse-cmd-list))) (list (quote on-message) json? body)))) nil)))
|
||||
(match-kw "end")
|
||||
(list (quote socket) name-path url timeout-ms on-msg))))))))
|
||||
(define
|
||||
parse-feat
|
||||
(fn
|
||||
@@ -2993,9 +2806,7 @@
|
||||
((= val "behavior") (do (adv!) (parse-behavior-feat)))
|
||||
((= val "live") (do (adv!) (parse-live-feat)))
|
||||
((= val "when") (do (adv!) (parse-when-feat)))
|
||||
((= val "worker")
|
||||
(error
|
||||
"worker plugin is not installed — see https://hyperscript.org/features/worker"))
|
||||
((= val "socket") (do (adv!) (parse-socket-feat)))
|
||||
(true (parse-cmd-list))))))
|
||||
(define
|
||||
coll-feats
|
||||
@@ -3014,13 +2825,4 @@
|
||||
(first features)
|
||||
(cons (quote do) features))))))
|
||||
|
||||
(define hs-span-mode false)
|
||||
|
||||
(define hs-compile (fn (src) (hs-parse (hs-tokenize src) src)))
|
||||
|
||||
(define hs-parse-ast
|
||||
(fn (src)
|
||||
(do
|
||||
(set! hs-span-mode true)
|
||||
(let ((result (hs-parse (hs-tokenize src) src)))
|
||||
(do (set! hs-span-mode false) result)))))
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -43,47 +43,29 @@
|
||||
|
||||
;; Run an initializer function immediately.
|
||||
;; (hs-init thunk) — called at element boot time
|
||||
(define meta (host-new "Object"))
|
||||
(define
|
||||
hs-on
|
||||
(fn
|
||||
(target event-name handler)
|
||||
(let
|
||||
((wrapped (fn (event) (guard (e ((and (not (= event-name "exception")) (not (= event-name "error"))) (dom-dispatch target "exception" {:error e})) (true (raise e))) (handler event)))))
|
||||
(let
|
||||
((unlisten (dom-listen target event-name wrapped))
|
||||
(prev (or (dom-get-data target "hs-unlisteners") (list))))
|
||||
(dom-set-data target "hs-unlisteners" (append prev (list unlisten)))
|
||||
unlisten))))
|
||||
|
||||
;; ── Async / timing ──────────────────────────────────────────────
|
||||
|
||||
;; Wait for a duration in milliseconds.
|
||||
;; In hyperscript, wait is async-transparent — execution pauses.
|
||||
;; Here we use perform/IO suspension for true pause semantics.
|
||||
(define
|
||||
_hs-on-caller
|
||||
(let
|
||||
((_ctx (host-new "Object"))
|
||||
(_m (host-new "Object"))
|
||||
(_f (host-new "Object")))
|
||||
(do
|
||||
(host-set! _f "type" "onFeature")
|
||||
(host-set! _m "feature" _f)
|
||||
(host-set! _ctx "meta" _m)
|
||||
_ctx)))
|
||||
|
||||
;; Wait for a DOM event on a target.
|
||||
;; (hs-wait-for target event-name) — suspends until event fires
|
||||
(define
|
||||
hs-on
|
||||
(fn
|
||||
(target event-name handler)
|
||||
(let
|
||||
((wrapped (fn (event) (do (host-set! meta "caller" _hs-on-caller) (host-set! meta "owner" target) (let ((__hs-no-stop false)) (guard (e ((and (not (= event-name "exception")) (not (= event-name "error"))) (do (when (and (list? e) (= (first e) "hs-halt-default")) (set! __hs-no-stop true)) (when (not __hs-no-stop) (dom-dispatch target "exception" {:error e})))) (true (raise e))) (handler event)) (when (not __hs-no-stop) (host-call event "stopPropagation")))))))
|
||||
(let
|
||||
((unlisten (dom-listen target event-name wrapped))
|
||||
(prev (or (dom-get-data target "hs-unlisteners") (list))))
|
||||
(dom-set-data target "hs-unlisteners" (append prev (list unlisten)))
|
||||
unlisten))))
|
||||
|
||||
;; Wait for CSS transitions/animations to settle on an element.
|
||||
(define
|
||||
hs-on-every
|
||||
(fn (target event-name handler) (dom-listen target event-name handler)))
|
||||
|
||||
;; ── Class manipulation ──────────────────────────────────────────
|
||||
|
||||
;; Toggle a single class on an element.
|
||||
;; Wait for a DOM event on a target.
|
||||
;; (hs-wait-for target event-name) — suspends until event fires
|
||||
(define
|
||||
hs-on-intersection-attach!
|
||||
(fn
|
||||
@@ -99,7 +81,7 @@
|
||||
(host-call observer "observe" target)
|
||||
observer)))))
|
||||
|
||||
;; Toggle between two classes — exactly one is active at a time.
|
||||
;; Wait for CSS transitions/animations to settle on an element.
|
||||
(define
|
||||
hs-on-mutation-attach!
|
||||
(fn
|
||||
@@ -120,19 +102,16 @@
|
||||
(host-call observer "observe" target opts)
|
||||
observer))))))
|
||||
|
||||
;; Take a class from siblings — add to target, remove from others.
|
||||
;; (hs-take! target cls) — like radio button class behavior
|
||||
;; ── Class manipulation ──────────────────────────────────────────
|
||||
|
||||
;; Toggle a single class on an element.
|
||||
(define hs-init (fn (thunk) (thunk)))
|
||||
|
||||
;; ── DOM insertion ───────────────────────────────────────────────
|
||||
|
||||
;; Put content at a position relative to a target.
|
||||
;; pos: "into" | "before" | "after"
|
||||
;; Toggle between two classes — exactly one is active at a time.
|
||||
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
|
||||
|
||||
;; ── Navigation / traversal ──────────────────────────────────────
|
||||
|
||||
;; Navigate to a URL.
|
||||
;; Take a class from siblings — add to target, remove from others.
|
||||
;; (hs-take! target cls) — like radio button class behavior
|
||||
(begin
|
||||
(define
|
||||
hs-wait-for
|
||||
@@ -145,15 +124,20 @@
|
||||
(target event-name timeout-ms)
|
||||
(perform (list (quote io-wait-event) target event-name timeout-ms)))))
|
||||
|
||||
;; Find next sibling matching a selector (or any sibling).
|
||||
;; ── DOM insertion ───────────────────────────────────────────────
|
||||
|
||||
;; Put content at a position relative to a target.
|
||||
;; pos: "into" | "before" | "after"
|
||||
(define hs-settle (fn (target) (perform (list (quote io-settle) target))))
|
||||
|
||||
;; Find previous sibling matching a selector.
|
||||
;; ── Navigation / traversal ──────────────────────────────────────
|
||||
|
||||
;; Navigate to a URL.
|
||||
(define
|
||||
hs-toggle-class!
|
||||
(fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
|
||||
|
||||
;; First element matching selector within a scope.
|
||||
;; Find next sibling matching a selector (or any sibling).
|
||||
(define
|
||||
hs-toggle-between!
|
||||
(fn
|
||||
@@ -163,7 +147,7 @@
|
||||
(do (dom-remove-class target cls1) (dom-add-class target cls2))
|
||||
(do (dom-remove-class target cls2) (dom-add-class target cls1)))))
|
||||
|
||||
;; Last element matching selector.
|
||||
;; Find previous sibling matching a selector.
|
||||
(define
|
||||
hs-toggle-style!
|
||||
(fn
|
||||
@@ -187,7 +171,7 @@
|
||||
(dom-set-style target prop "hidden")
|
||||
(dom-set-style target prop "")))))))
|
||||
|
||||
;; First/last within a specific scope.
|
||||
;; First element matching selector within a scope.
|
||||
(define
|
||||
hs-toggle-style-between!
|
||||
(fn
|
||||
@@ -199,6 +183,7 @@
|
||||
(dom-set-style target prop val2)
|
||||
(dom-set-style target prop val1)))))
|
||||
|
||||
;; Last element matching selector.
|
||||
(define
|
||||
hs-toggle-style-cycle!
|
||||
(fn
|
||||
@@ -219,9 +204,7 @@
|
||||
(true (find-next (rest remaining))))))
|
||||
(dom-set-style target prop (find-next vals)))))
|
||||
|
||||
;; ── Iteration ───────────────────────────────────────────────────
|
||||
|
||||
;; Repeat a thunk N times.
|
||||
;; First/last within a specific scope.
|
||||
(define
|
||||
hs-take!
|
||||
(fn
|
||||
@@ -261,7 +244,6 @@
|
||||
(dom-set-attr target name attr-val)
|
||||
(dom-set-attr target name ""))))))))
|
||||
|
||||
;; Repeat forever (until break — relies on exception/continuation).
|
||||
(begin
|
||||
(define
|
||||
hs-element?
|
||||
@@ -311,26 +293,7 @@
|
||||
hs-set-inner-html!
|
||||
(fn
|
||||
(target value)
|
||||
(let
|
||||
((str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) value)))
|
||||
(do (dom-set-inner-html target str-val) (hs-boot-subtree! target)))))
|
||||
(define
|
||||
hs-set-element!
|
||||
(fn
|
||||
(target value)
|
||||
(let ((parent (dom-parent target)))
|
||||
(when parent
|
||||
(let ((tmp (dom-create-element "div"))
|
||||
(str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) value)))
|
||||
(do
|
||||
(dom-set-inner-html tmp str-val)
|
||||
(let ((children (host-get tmp "children")))
|
||||
(if (> (len children) 0)
|
||||
(let ((new-el (first children)))
|
||||
(do
|
||||
(host-call parent "replaceChild" new-el target)
|
||||
(hs-boot-subtree! new-el)))
|
||||
(hs-set-inner-html! target str-val)))))))))
|
||||
(do (dom-set-inner-html target value) (hs-boot-subtree! target))))
|
||||
(define
|
||||
hs-put!
|
||||
(fn
|
||||
@@ -392,10 +355,9 @@
|
||||
(dom-insert-adjacent-html target "beforeend" value)
|
||||
(hs-boot-subtree! target)))))))))
|
||||
|
||||
;; ── Fetch ───────────────────────────────────────────────────────
|
||||
;; ── Iteration ───────────────────────────────────────────────────
|
||||
|
||||
;; Fetch a URL, parse response according to format.
|
||||
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
||||
;; Repeat a thunk N times.
|
||||
(define
|
||||
hs-add-to!
|
||||
(fn
|
||||
@@ -408,10 +370,7 @@
|
||||
(append target (list value))))
|
||||
(true (do (host-call target "push" value) target)))))
|
||||
|
||||
;; ── Type coercion ───────────────────────────────────────────────
|
||||
|
||||
;; Coerce a value to a type by name.
|
||||
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
||||
;; Repeat forever (until break — relies on exception/continuation).
|
||||
(define
|
||||
hs-remove-from!
|
||||
(fn
|
||||
@@ -421,10 +380,10 @@
|
||||
(filter (fn (x) (not (= x value))) target)
|
||||
(host-call target "splice" (host-call target "indexOf" value) 1))))
|
||||
|
||||
;; ── Object creation ─────────────────────────────────────────────
|
||||
;; ── Fetch ───────────────────────────────────────────────────────
|
||||
|
||||
;; Make a new object of a given type.
|
||||
;; (hs-make type-name) — creates empty object/collection
|
||||
;; Fetch a URL, parse response according to format.
|
||||
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
||||
(define
|
||||
hs-splice-at!
|
||||
(fn
|
||||
@@ -448,11 +407,10 @@
|
||||
(host-call target "splice" i 1))))
|
||||
target))))
|
||||
|
||||
;; ── Behavior installation ───────────────────────────────────────
|
||||
;; ── Type coercion ───────────────────────────────────────────────
|
||||
|
||||
;; 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)
|
||||
;; Coerce a value to a type by name.
|
||||
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
||||
(define
|
||||
hs-index
|
||||
(fn
|
||||
@@ -464,10 +422,10 @@
|
||||
((string? obj) (nth obj key))
|
||||
(true (host-get obj key)))))
|
||||
|
||||
;; ── Measurement ─────────────────────────────────────────────────
|
||||
;; ── Object creation ─────────────────────────────────────────────
|
||||
|
||||
;; Measure an element's bounding rect, store as local variables.
|
||||
;; Returns a dict with x, y, width, height, top, left, right, bottom.
|
||||
;; Make a new object of a given type.
|
||||
;; (hs-make type-name) — creates empty object/collection
|
||||
(define
|
||||
hs-put-at!
|
||||
(fn
|
||||
@@ -489,10 +447,11 @@
|
||||
((= pos "start") (host-call target "unshift" value)))
|
||||
target)))))))
|
||||
|
||||
;; Return the current text selection as a string. In the browser this is
|
||||
;; `window.getSelection().toString()`. In the mock test runner, a test
|
||||
;; setup stashes the desired selection text at `window.__test_selection`
|
||||
;; and the fallback path returns that so tests can assert on the result.
|
||||
;; ── 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-dict-without
|
||||
(fn
|
||||
@@ -513,19 +472,27 @@
|
||||
(host-call (host-global "Reflect") "deleteProperty" out key)
|
||||
out)))))
|
||||
|
||||
;; ── Measurement ─────────────────────────────────────────────────
|
||||
|
||||
;; ── Transition ──────────────────────────────────────────────────
|
||||
|
||||
;; Transition a CSS property to a value, optionally with duration.
|
||||
;; (hs-transition target prop value duration)
|
||||
;; Measure an element's bounding rect, store as local variables.
|
||||
;; Returns a dict with x, y, width, height, top, left, right, bottom.
|
||||
(define
|
||||
hs-set-on!
|
||||
(fn
|
||||
(props target)
|
||||
(for-each (fn (k) (host-set! target k (get props k))) (keys props))))
|
||||
|
||||
;; Return the current text selection as a string. In the browser this is
|
||||
;; `window.getSelection().toString()`. In the mock test runner, a test
|
||||
;; setup stashes the desired selection text at `window.__test_selection`
|
||||
;; and the fallback path returns that so tests can assert on the result.
|
||||
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
|
||||
|
||||
|
||||
;; ── Transition ──────────────────────────────────────────────────
|
||||
|
||||
;; Transition a CSS property to a value, optionally with duration.
|
||||
;; (hs-transition target prop value duration)
|
||||
(define
|
||||
hs-ask
|
||||
(fn
|
||||
@@ -580,7 +547,7 @@
|
||||
(do
|
||||
(host-call ev "preventDefault")
|
||||
(host-call ev "stopPropagation")))))
|
||||
(when (not (= mode "the-event")) (raise (list (if (= mode "default") "hs-halt-default" "hs-return") nil))))))
|
||||
(when (not (= mode "the-event")) (raise (list "hs-return" nil))))))
|
||||
|
||||
(define hs-select! (fn (target) (host-call target "select" (list))))
|
||||
|
||||
@@ -664,10 +631,6 @@
|
||||
(true (find-next (dom-next-sibling el))))))
|
||||
(find-next sibling)))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define
|
||||
hs-previous
|
||||
(fn
|
||||
@@ -690,8 +653,11 @@
|
||||
(define
|
||||
hs-query-all
|
||||
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define
|
||||
hs-query-all-in
|
||||
(fn
|
||||
@@ -700,23 +666,22 @@
|
||||
(nil? target)
|
||||
(hs-query-all sel)
|
||||
(host-call target "querySelectorAll" sel))))
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
|
||||
(define
|
||||
hs-list-set
|
||||
(fn
|
||||
(lst idx val)
|
||||
(append (take lst idx) (cons val (drop lst (+ idx 1))))))
|
||||
;; Method dispatch — obj.method(args)
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
(define
|
||||
hs-to-number
|
||||
(fn (v) (if (number? v) v (or (parse-number (str v)) 0))))
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
(define
|
||||
hs-query-first
|
||||
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
|
||||
;; Property-based is — check obj.key truthiness
|
||||
;; Method dispatch — obj.method(args)
|
||||
(define
|
||||
hs-query-last
|
||||
(fn
|
||||
@@ -724,9 +689,11 @@
|
||||
(let
|
||||
((all (dom-query-all (dom-body) sel)))
|
||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||
;; Array slicing (inclusive both ends)
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
(define hs-first (fn (scope sel) (dom-query-all scope sel)))
|
||||
;; Collection: sorted by
|
||||
;; Property-based is — check obj.key truthiness
|
||||
(define
|
||||
hs-last
|
||||
(fn
|
||||
@@ -734,7 +701,7 @@
|
||||
(let
|
||||
((all (dom-query-all scope sel)))
|
||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||
;; Collection: sorted by descending
|
||||
;; Array slicing (inclusive both ends)
|
||||
(define
|
||||
hs-repeat-times
|
||||
(fn
|
||||
@@ -752,7 +719,7 @@
|
||||
((= signal "hs-continue") (do-repeat (+ i 1)))
|
||||
(true (do-repeat (+ i 1))))))))
|
||||
(do-repeat 0)))
|
||||
;; Collection: split by
|
||||
;; Collection: sorted by
|
||||
(define
|
||||
hs-repeat-forever
|
||||
(fn
|
||||
@@ -768,7 +735,7 @@
|
||||
((= signal "hs-continue") (do-forever))
|
||||
(true (do-forever))))))
|
||||
(do-forever)))
|
||||
;; Collection: joined by
|
||||
;; Collection: sorted by descending
|
||||
(define
|
||||
hs-repeat-while
|
||||
(fn
|
||||
@@ -781,7 +748,7 @@
|
||||
((= signal "hs-break") nil)
|
||||
((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
|
||||
(true (hs-repeat-while cond-fn thunk)))))))
|
||||
|
||||
;; Collection: split by
|
||||
(define
|
||||
hs-repeat-until
|
||||
(fn
|
||||
@@ -793,13 +760,13 @@
|
||||
((= signal "hs-continue")
|
||||
(if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
|
||||
(true (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))))))
|
||||
|
||||
;; Collection: joined by
|
||||
(define
|
||||
hs-for-each
|
||||
(fn
|
||||
(fn-body collection)
|
||||
(let
|
||||
((items (cond ((list? collection) collection) ((nil? collection) (list)) ((host-iter? collection) (host-to-list collection)) ((dict? collection) (if (dict-has? collection "_order") (get collection "_order") (filter (fn (k) (not (= k "_order"))) (keys collection)))) (true (list)))))
|
||||
((items (cond ((list? collection) collection) ((dict? collection) (if (dict-has? collection "_order") (get collection "_order") (filter (fn (k) (not (= k "_order"))) (keys collection)))) ((nil? collection) (list)) (true (list)))))
|
||||
(define
|
||||
do-loop
|
||||
(fn
|
||||
@@ -829,8 +796,7 @@
|
||||
(append target (list value))))
|
||||
((hs-element? target)
|
||||
(do
|
||||
(dom-insert-adjacent-html target "beforeend"
|
||||
(if (hs-element? value) (host-get value "outerHTML") (str value)))
|
||||
(dom-insert-adjacent-html target "beforeend" (str value))
|
||||
target))
|
||||
(true (str target value)))))
|
||||
(define
|
||||
@@ -840,8 +806,7 @@
|
||||
(cond
|
||||
((nil? target) nil)
|
||||
((hs-element? target)
|
||||
(dom-insert-adjacent-html target "beforeend"
|
||||
(if (hs-element? value) (host-get value "outerHTML") (str value))))
|
||||
(dom-insert-adjacent-html target "beforeend" (str value)))
|
||||
(true nil)))))
|
||||
|
||||
(define
|
||||
@@ -907,44 +872,14 @@
|
||||
out)))))))))))
|
||||
|
||||
(define
|
||||
hs-fetch-impl
|
||||
hs-fetch
|
||||
(fn
|
||||
(url format no-throw)
|
||||
(url format)
|
||||
(let
|
||||
((fmt (cond
|
||||
((nil? format) "text")
|
||||
((or (= format "json") (= format "JSON") (= format "Object")) "json")
|
||||
((or (= format "html") (= format "HTML")) "html")
|
||||
((or (= format "response") (= format "Response")) "response")
|
||||
((or (= format "text") (= format "Text")) "text")
|
||||
((or (= format "number") (= format "Number")) "number")
|
||||
(true "text"))))
|
||||
(let
|
||||
((_hs-before-caller (host-get meta "owner")))
|
||||
(when _hs-before-caller
|
||||
(dom-dispatch _hs-before-caller "hyperscript:beforeFetch" {:url url})))
|
||||
((fmt (cond ((nil? format) "text") ((or (= format "json") (= format "JSON") (= format "Object")) "json") ((or (= format "html") (= format "HTML")) "html") ((or (= format "response") (= format "Response")) "response") ((or (= format "text") (= format "Text")) "text") (true format))))
|
||||
(let
|
||||
((raw (perform (list "io-fetch" url fmt))))
|
||||
(begin
|
||||
(when (= (host-get raw "_network-error") true)
|
||||
(raise (or (host-get raw "message") "Network error")))
|
||||
(when (and (not no-throw) (not (= fmt "response")) (= (host-get raw "ok") false))
|
||||
(raise (str "HTTP Error: " (host-get raw "status"))))
|
||||
(cond
|
||||
((= fmt "response") raw)
|
||||
((= fmt "json")
|
||||
(hs-host-to-sx (perform (list "io-parse-json" raw))))
|
||||
((= fmt "number")
|
||||
(hs-to-number (perform (list "io-parse-text" raw))))
|
||||
(true (perform (list "io-parse-text" raw)))))))))
|
||||
|
||||
(define
|
||||
hs-fetch
|
||||
(fn (url format) (hs-fetch-impl url format false)))
|
||||
|
||||
(define
|
||||
hs-fetch-no-throw
|
||||
(fn (url format) (hs-fetch-impl url format true)))
|
||||
(cond ((= fmt "json") (hs-host-to-sx raw)) (true raw))))))
|
||||
|
||||
(define
|
||||
hs-json-escape
|
||||
@@ -1035,10 +970,9 @@
|
||||
(true (str value))))
|
||||
((= type-name "JSON")
|
||||
(cond
|
||||
((string? value) (guard (_e (true value)) (hs-host-to-sx (json-parse value))))
|
||||
((not (nil? (host-get value "_json")))
|
||||
(hs-host-to-sx (perform (list "io-parse-json" value))))
|
||||
((dict? value) value)
|
||||
((string? value) (guard (_e (true value)) (json-parse value)))
|
||||
((dict? value) (hs-json-stringify value))
|
||||
((list? value) (hs-json-stringify value))
|
||||
(true value)))
|
||||
((= type-name "Object")
|
||||
(if
|
||||
@@ -1197,17 +1131,7 @@
|
||||
(if
|
||||
(host-get node "multiple")
|
||||
(hs-select-multi-values node)
|
||||
(let
|
||||
((idx (host-get node "selectedIndex"))
|
||||
(opts (host-get node "options"))
|
||||
(raw-val (host-get node "value")))
|
||||
(if
|
||||
(and (not (nil? raw-val)) (not (= raw-val "")))
|
||||
raw-val
|
||||
(if
|
||||
(and (not (nil? opts)) (>= idx 0))
|
||||
(host-get (if (list? opts) (nth opts idx) (host-get opts idx)) "value")
|
||||
"")))))
|
||||
(host-get node "value")))
|
||||
((or (= typ "checkbox") (= typ "radio"))
|
||||
(if (host-get node "checked") (host-get node "value") nil))
|
||||
(true (host-get node "value"))))))
|
||||
@@ -1424,21 +1348,14 @@
|
||||
hs-transition
|
||||
(fn
|
||||
(target prop value duration)
|
||||
(let
|
||||
((init-attr (str "data-hs-init-" prop)))
|
||||
(when
|
||||
(not (dom-get-attr target init-attr))
|
||||
(dom-set-attr target init-attr (dom-get-style target prop)))
|
||||
(let
|
||||
((actual-value (if (= value "initial") (dom-get-attr target init-attr) value)))
|
||||
(when
|
||||
duration
|
||||
(dom-set-style
|
||||
target
|
||||
"transition"
|
||||
(str prop " " (/ duration 1000) "s")))
|
||||
(dom-set-style target prop actual-value)
|
||||
(when duration (hs-settle target))))))
|
||||
(when
|
||||
duration
|
||||
(dom-set-style
|
||||
target
|
||||
"transition"
|
||||
(str prop " " (/ duration 1000) "s")))
|
||||
(dom-set-style target prop value)
|
||||
(when duration (hs-settle target))))
|
||||
|
||||
(define
|
||||
hs-transition-from
|
||||
@@ -1501,15 +1418,6 @@
|
||||
hs-strict-eq
|
||||
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
|
||||
|
||||
(define
|
||||
hs-id=
|
||||
(fn
|
||||
(a b)
|
||||
(if
|
||||
(and (= (host-typeof a) "element") (= (host-typeof b) "element"))
|
||||
(hs-ref-eq a b)
|
||||
(= a b))))
|
||||
|
||||
(define
|
||||
hs-eq-ignore-case
|
||||
(fn (a b) (= (downcase (str a)) (downcase (str b)))))
|
||||
@@ -2189,13 +2097,20 @@
|
||||
(fn
|
||||
(pairs)
|
||||
(let
|
||||
((d {}))
|
||||
((d {}) (order (list)))
|
||||
(do
|
||||
(for-each
|
||||
(fn
|
||||
(pair)
|
||||
(dict-set! d (first pair) (nth pair 1)))
|
||||
(let
|
||||
((k (first pair)))
|
||||
(do
|
||||
(when
|
||||
(not (dict-has? d k))
|
||||
(set! order (append order (list k))))
|
||||
(dict-set! d k (nth pair 1)))))
|
||||
pairs)
|
||||
(when (not (empty? order)) (dict-set! d "_order" order))
|
||||
d))))
|
||||
|
||||
(define
|
||||
@@ -2596,8 +2511,6 @@
|
||||
((nth entry 2) val)))
|
||||
_hs-dom-watchers)))
|
||||
|
||||
;; ── SourceInfo API ────────────────────────────────────────────────
|
||||
|
||||
(define
|
||||
hs-dom-is-ancestor?
|
||||
(fn
|
||||
@@ -2613,208 +2526,111 @@
|
||||
(fn-name args)
|
||||
(let ((fn (host-global fn-name))) (if fn (host-call-fn fn args) nil))))
|
||||
|
||||
(define
|
||||
hs-source-for
|
||||
(fn
|
||||
(node)
|
||||
(substring (get node :src) (get node :start) (get node :end))))
|
||||
;; ── WebSocket / socket feature ───────────────────────────────────
|
||||
|
||||
(define
|
||||
hs-line-for
|
||||
hs-try-json-parse
|
||||
(fn (s) (host-call (host-global "JSON") "parse" s)))
|
||||
|
||||
(define
|
||||
hs-socket-resolve-rpc!
|
||||
(fn
|
||||
(node)
|
||||
(wrapper msg)
|
||||
(let
|
||||
((lines (split (get node :src) "\n"))
|
||||
(line-idx (- (get node :line) 1)))
|
||||
(if (< line-idx (len lines)) (nth lines line-idx) ""))))
|
||||
|
||||
(define hs-node-get (fn (node key) (get (get node :fields) key)))
|
||||
|
||||
(define hs-src (fn (src-str) (hs-source-for (hs-parse-ast src-str))))
|
||||
|
||||
(define
|
||||
hs-src-at
|
||||
(fn
|
||||
(src-str path)
|
||||
(define
|
||||
walk
|
||||
(fn
|
||||
(node keys)
|
||||
(if
|
||||
(or (nil? keys) (= (len keys) 0))
|
||||
node
|
||||
(walk (hs-node-get node (first keys)) (rest keys)))))
|
||||
(hs-source-for (walk (hs-parse-ast src-str) path))))
|
||||
|
||||
(define
|
||||
hs-line-at
|
||||
(fn
|
||||
(src-str path)
|
||||
(define
|
||||
walk
|
||||
(fn
|
||||
(node keys)
|
||||
(if
|
||||
(or (nil? keys) (= (len keys) 0))
|
||||
node
|
||||
(walk (hs-node-get node (first keys)) (rest keys)))))
|
||||
(hs-line-for (walk (hs-parse-ast src-str) path))))
|
||||
|
||||
(define
|
||||
hs-js-exec
|
||||
(fn
|
||||
(param-names js-src bound-args)
|
||||
(let
|
||||
((js-fn (host-new-function param-names js-src)))
|
||||
((pending (host-get wrapper "pending")) (iid (host-get msg "iid")))
|
||||
(let
|
||||
((result (host-call-fn js-fn bound-args)))
|
||||
(if
|
||||
(= (host-typeof result) "promise")
|
||||
(let
|
||||
((state (host-promise-state result)))
|
||||
(if
|
||||
(and state (= (host-get state "ok") false))
|
||||
(raise (host-get state "value"))
|
||||
(if state (host-get state "value") result)))
|
||||
result)))))
|
||||
|
||||
(define
|
||||
hs-raw->api-token
|
||||
(fn
|
||||
(raw)
|
||||
(let
|
||||
((type (dict-get raw :type)) (value (dict-get raw :value)))
|
||||
(cond
|
||||
(= type "ident")
|
||||
{:value value :type "IDENTIFIER" :op false}
|
||||
(= type "keyword")
|
||||
{:value value :type "IDENTIFIER" :op false}
|
||||
(= type "number")
|
||||
{:value value :type "NUMBER" :op false}
|
||||
(= type "string")
|
||||
{:value value :type "STRING" :op false}
|
||||
(= type "class")
|
||||
{:value (str "." value) :type "CLASS_REF" :op false}
|
||||
(= type "id")
|
||||
{:value (str "#" value) :type "ID_REF" :op false}
|
||||
(= type "attr")
|
||||
{:value value :type "ATTRIBUTE_REF" :op false}
|
||||
(= type "style")
|
||||
{:value value :type "STYLE_REF" :op false}
|
||||
(= type "selector")
|
||||
{:value value :type "QUERY_REF" :op false}
|
||||
(= type "eof")
|
||||
{:value "<<<EOF>>>" :type "EOF" :op false}
|
||||
(= type "paren-open")
|
||||
{:value value :type "L_PAREN" :op true}
|
||||
(= type "paren-close")
|
||||
{:value value :type "R_PAREN" :op true}
|
||||
(= type "bracket-open")
|
||||
{:value value :type "L_BRACKET" :op true}
|
||||
(= type "bracket-close")
|
||||
{:value value :type "R_BRACKET" :op true}
|
||||
(= type "brace-open")
|
||||
{:value value :type "L_BRACE" :op true}
|
||||
(= type "brace-close")
|
||||
{:value value :type "R_BRACE" :op true}
|
||||
(= type "comma")
|
||||
{:value value :type "COMMA" :op true}
|
||||
(= type "dot")
|
||||
{:value value :type "PERIOD" :op true}
|
||||
(= type "colon")
|
||||
{:value value :type "COLON" :op true}
|
||||
(= type "op")
|
||||
(cond
|
||||
(= value "+") {:value value :type "PLUS" :op true}
|
||||
(= value "-") {:value value :type "MINUS" :op true}
|
||||
(= value "*") {:value value :type "MULTIPLY" :op true}
|
||||
(= value "/") {:value value :type "SLASH" :op true}
|
||||
(= value "!") {:value value :type "EXCLAMATION" :op true}
|
||||
(= value "?") {:value value :type "QUESTION" :op true}
|
||||
(= value "#") {:value value :type "POUND" :op true}
|
||||
(= value "&") {:value value :type "AMPERSAND" :op true}
|
||||
(= value "=") {:value value :type "EQUALS" :op true}
|
||||
(= value "<") {:value value :type "L_ANG" :op true}
|
||||
(= value ">") {:value value :type "R_ANG" :op true}
|
||||
(= value "<=") {:value value :type "LTE_ANG" :op true}
|
||||
(= value ">=") {:value value :type "GTE_ANG" :op true}
|
||||
(= value "==") {:value value :type "EQ" :op true}
|
||||
(= value "===") {:value value :type "EQQ" :op true}
|
||||
(= value "..") {:value value :type "PERIOD_PERIOD" :op true}
|
||||
:else {:value value :type value :op true})
|
||||
:else {:value (or value "") :type (str type) :op false}))))
|
||||
|
||||
(define hs-eof-sentinel {:value "<<<EOF>>>" :type "EOF" :op false})
|
||||
|
||||
(define
|
||||
hs-tokens-of
|
||||
(fn
|
||||
(src &rest args)
|
||||
(let
|
||||
((template (some (fn (a) (equal? a :template)) args)))
|
||||
(let
|
||||
((raw (if template (hs-tokenize-template src) (hs-tokenize src))))
|
||||
{:pos 0 :list (filter (fn (t) (not (= (dict-get t :type) "EOF"))) (map hs-raw->api-token raw)) :source src}))))
|
||||
|
||||
(define
|
||||
hs-stream-token
|
||||
(fn
|
||||
(s i)
|
||||
(let
|
||||
((lst (dict-get s :list))
|
||||
(n (len (dict-get s :list))))
|
||||
(define
|
||||
find
|
||||
(fn
|
||||
(pos count)
|
||||
((resolver (host-get pending iid)))
|
||||
(when
|
||||
(not (nil? resolver))
|
||||
(if
|
||||
(>= pos n)
|
||||
hs-eof-sentinel
|
||||
(let
|
||||
((tok (nth lst pos)))
|
||||
(if
|
||||
(= (dict-get tok :type) "whitespace")
|
||||
(find (+ pos 1) count)
|
||||
(if
|
||||
(= count 0)
|
||||
tok
|
||||
(find (+ pos 1) (- count 1))))))))
|
||||
(find (dict-get s :pos) i))))
|
||||
(not (nil? (host-get msg "return")))
|
||||
(host-call resolver "resolve" (host-get msg "return"))
|
||||
(host-call resolver "reject" (host-get msg "throw")))
|
||||
(host-set! pending iid nil))))))
|
||||
|
||||
(define
|
||||
hs-stream-consume
|
||||
hs-socket-register!
|
||||
(fn
|
||||
(s)
|
||||
(name-path url timeout-ms handler json?)
|
||||
(let
|
||||
((lst (dict-get s :list))
|
||||
(n (len (dict-get s :list))))
|
||||
(define
|
||||
find-pos
|
||||
(fn
|
||||
(pos)
|
||||
(if
|
||||
(>= pos n)
|
||||
pos
|
||||
(if
|
||||
(= (dict-get (nth lst pos) :type) "whitespace")
|
||||
(find-pos (+ pos 1))
|
||||
pos))))
|
||||
((ws-url (cond ((or (starts-with? url "ws://") (starts-with? url "wss://")) url) (true (let ((proto (host-get (host-global "location") "protocol")) (h (host-get (host-global "location") "host"))) (str (if (= proto "https:") "wss:" "ws:") "//" h url))))))
|
||||
(let
|
||||
((p (find-pos (dict-get s :pos))))
|
||||
((ws (host-new "WebSocket" ws-url)))
|
||||
(let
|
||||
((tok (if (>= p n) hs-eof-sentinel (nth lst p))))
|
||||
(do
|
||||
((wrapper (host-new "Object")))
|
||||
(host-set! wrapper "raw" ws)
|
||||
(host-set! wrapper "url" ws-url)
|
||||
(host-set! wrapper "timeout" timeout-ms)
|
||||
(host-set! wrapper "pending" (host-new "Object"))
|
||||
(host-set! wrapper "handler" handler)
|
||||
(host-set! wrapper "json?" json?)
|
||||
(host-set! wrapper "closed?" false)
|
||||
(host-set! wrapper "closedFlag" nil)
|
||||
(let
|
||||
((proxy-factory (host-global "_hs_make_rpc_proxy")))
|
||||
(when
|
||||
(not (= (dict-get tok :type) "EOF"))
|
||||
(dict-set! s :pos (+ p 1)))
|
||||
tok))))))
|
||||
|
||||
(define
|
||||
hs-stream-has-more
|
||||
(fn (s) (not (= (dict-get (hs-stream-token s 0) :type) "EOF"))))
|
||||
|
||||
(define hs-token-type (fn (tok) (dict-get tok :type)))
|
||||
|
||||
(define hs-token-value (fn (tok) (dict-get tok :value)))
|
||||
|
||||
(define hs-token-op? (fn (tok) (dict-get tok :op)))
|
||||
proxy-factory
|
||||
(host-set!
|
||||
wrapper
|
||||
"rpc"
|
||||
(host-call proxy-factory "call" nil wrapper))))
|
||||
(host-set!
|
||||
ws
|
||||
"onmessage"
|
||||
(host-callback
|
||||
(fn
|
||||
(event)
|
||||
(let
|
||||
((data (host-get event "data")))
|
||||
(let
|
||||
((parsed (hs-try-json-parse data)))
|
||||
(cond
|
||||
((and (not (nil? parsed)) (not (nil? (host-get parsed "iid"))))
|
||||
(hs-socket-resolve-rpc! wrapper parsed))
|
||||
((not (nil? handler))
|
||||
(if
|
||||
json?
|
||||
(if
|
||||
(not (nil? parsed))
|
||||
(handler parsed)
|
||||
(error "Received non-JSON message"))
|
||||
(handler event)))))))))
|
||||
(host-call
|
||||
ws
|
||||
"addEventListener"
|
||||
"close"
|
||||
(host-callback
|
||||
(fn
|
||||
(evt)
|
||||
(host-set! wrapper "closedFlag" "1"))))
|
||||
(host-set!
|
||||
wrapper
|
||||
"dispatchEvent"
|
||||
(host-callback
|
||||
(fn
|
||||
(evt)
|
||||
(let
|
||||
((payload (host-new "Object")))
|
||||
(host-set! payload "type" (host-get evt "type"))
|
||||
(host-call
|
||||
(host-get wrapper "raw")
|
||||
"send"
|
||||
(host-call
|
||||
(host-global "JSON")
|
||||
"stringify"
|
||||
payload))))))
|
||||
(define
|
||||
bind-path!
|
||||
(fn
|
||||
(obj path)
|
||||
(if
|
||||
(= (len path) 1)
|
||||
(host-set! obj (first path) wrapper)
|
||||
(let
|
||||
((key (first path)) (rest-path (rest path)))
|
||||
(let
|
||||
((next (or (host-get obj key) (host-new "Object"))))
|
||||
(host-set! obj key next)
|
||||
(bind-path! next rest-path))))))
|
||||
(bind-path! (host-global "window") name-path)
|
||||
wrapper)))))
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -28,27 +28,6 @@
|
||||
|
||||
(define hs-ws? (fn (c) (or (= c " ") (= c "\t") (= c "\n") (= c "\r"))))
|
||||
|
||||
(define
|
||||
hs-hex-digit?
|
||||
(fn
|
||||
(c)
|
||||
(or
|
||||
(and (>= c "0") (<= c "9"))
|
||||
(and (>= c "a") (<= c "f"))
|
||||
(and (>= c "A") (<= c "F")))))
|
||||
|
||||
(define
|
||||
hs-hex-val
|
||||
(fn
|
||||
(c)
|
||||
(let
|
||||
((code (char-code c)))
|
||||
(cond
|
||||
((and (>= code 48) (<= code 57)) (- code 48))
|
||||
((and (>= code 65) (<= code 70)) (- code 55))
|
||||
((and (>= code 97) (<= code 102)) (- code 87))
|
||||
(true 0)))))
|
||||
|
||||
;; ── Keyword set ───────────────────────────────────────────────────
|
||||
|
||||
(define
|
||||
@@ -131,7 +110,6 @@
|
||||
"append"
|
||||
"settle"
|
||||
"transition"
|
||||
"view"
|
||||
"over"
|
||||
"closest"
|
||||
"next"
|
||||
@@ -257,15 +235,10 @@
|
||||
read-number
|
||||
(fn
|
||||
(start)
|
||||
(define
|
||||
read-int
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(and (< pos src-len) (hs-digit? (hs-cur)))
|
||||
(hs-advance! 1)
|
||||
(read-int))))
|
||||
(read-int)
|
||||
(when
|
||||
(and (< pos src-len) (hs-digit? (hs-cur)))
|
||||
(hs-advance! 1)
|
||||
(read-number start))
|
||||
(when
|
||||
(and
|
||||
(< pos src-len)
|
||||
@@ -273,7 +246,15 @@
|
||||
(< (+ pos 1) src-len)
|
||||
(hs-digit? (hs-peek 1)))
|
||||
(hs-advance! 1)
|
||||
(read-int))
|
||||
(define
|
||||
read-frac
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(and (< pos src-len) (hs-digit? (hs-cur)))
|
||||
(hs-advance! 1)
|
||||
(read-frac))))
|
||||
(read-frac))
|
||||
(do
|
||||
(when
|
||||
(and
|
||||
@@ -291,7 +272,15 @@
|
||||
(< pos src-len)
|
||||
(or (= (hs-cur) "+") (= (hs-cur) "-")))
|
||||
(hs-advance! 1))
|
||||
(read-int))
|
||||
(define
|
||||
read-exp-digits
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(and (< pos src-len) (hs-digit? (hs-cur)))
|
||||
(hs-advance! 1)
|
||||
(read-exp-digits))))
|
||||
(read-exp-digits))
|
||||
(let
|
||||
((num-end pos))
|
||||
(when
|
||||
@@ -319,7 +308,7 @@
|
||||
()
|
||||
(cond
|
||||
(>= pos src-len)
|
||||
(error "Unterminated string")
|
||||
nil
|
||||
(= (hs-cur) "\\")
|
||||
(do
|
||||
(hs-advance! 1)
|
||||
@@ -329,37 +318,15 @@
|
||||
((ch (hs-cur)))
|
||||
(cond
|
||||
(= ch "n")
|
||||
(do (append! chars "\n") (hs-advance! 1))
|
||||
(append! chars "\n")
|
||||
(= ch "t")
|
||||
(do (append! chars "\t") (hs-advance! 1))
|
||||
(= ch "r")
|
||||
(do (append! chars "\r") (hs-advance! 1))
|
||||
(= ch "b")
|
||||
(do (append! chars (char-from-code 8)) (hs-advance! 1))
|
||||
(= ch "f")
|
||||
(do (append! chars (char-from-code 12)) (hs-advance! 1))
|
||||
(= ch "v")
|
||||
(do (append! chars (char-from-code 11)) (hs-advance! 1))
|
||||
(append! chars "\t")
|
||||
(= ch "\\")
|
||||
(do (append! chars "\\") (hs-advance! 1))
|
||||
(append! chars "\\")
|
||||
(= ch quote-char)
|
||||
(do (append! chars quote-char) (hs-advance! 1))
|
||||
(= ch "x")
|
||||
(do
|
||||
(hs-advance! 1)
|
||||
(if
|
||||
(and
|
||||
(< (+ pos 1) src-len)
|
||||
(hs-hex-digit? (hs-cur))
|
||||
(hs-hex-digit? (hs-peek 1)))
|
||||
(let
|
||||
((d1 (hs-hex-val (hs-cur)))
|
||||
(d2 (hs-hex-val (hs-peek 1))))
|
||||
(append! chars (char-from-code (+ (* d1 16) d2)))
|
||||
(hs-advance! 2))
|
||||
(error "Invalid hexadecimal escape: \\x")))
|
||||
:else
|
||||
(do (append! chars "\\") (append! chars ch) (hs-advance! 1)))))
|
||||
(append! chars quote-char)
|
||||
:else (do (append! chars "\\") (append! chars ch)))
|
||||
(hs-advance! 1)))
|
||||
(loop))
|
||||
(= (hs-cur) quote-char)
|
||||
(hs-advance! 1)
|
||||
@@ -461,23 +428,12 @@
|
||||
hs-emit!
|
||||
(fn
|
||||
(type value start)
|
||||
(let
|
||||
((tok (hs-make-token type value start))
|
||||
(end-pos (max pos (+ start (if (nil? value) 0 (len (str value)))))))
|
||||
(do
|
||||
(dict-set! tok "end" end-pos)
|
||||
(dict-set! tok "line" (len (split (slice src 0 start) "\n")))
|
||||
(append! tokens tok)))))
|
||||
(append! tokens (hs-make-token type value start))))
|
||||
(define
|
||||
scan!
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((ws-start pos))
|
||||
(skip-ws!)
|
||||
(when
|
||||
(and (> (len tokens) 0) (> pos ws-start))
|
||||
(hs-emit! "whitespace" (slice src ws-start pos) ws-start)))
|
||||
(skip-ws!)
|
||||
(when
|
||||
(< pos src-len)
|
||||
(let
|
||||
@@ -485,7 +441,11 @@
|
||||
(cond
|
||||
(and (= ch "-") (< (+ pos 1) src-len) (= (hs-peek 1) "-"))
|
||||
(do (hs-advance! 2) (skip-comment!) (scan!))
|
||||
(and (= ch "/") (< (+ pos 1) src-len) (= (hs-peek 1) "/"))
|
||||
(and
|
||||
(= ch "/")
|
||||
(< (+ pos 1) src-len)
|
||||
(= (hs-peek 1) "/")
|
||||
(not (and (> pos 0) (= (hs-peek -1) ":"))))
|
||||
(do (hs-advance! 2) (skip-comment!) (scan!))
|
||||
(and
|
||||
(= ch "<")
|
||||
@@ -501,15 +461,6 @@
|
||||
(do (hs-emit! "selector" (read-selector) start) (scan!))
|
||||
(and (= ch ".") (< (+ pos 1) src-len) (= (hs-peek 1) "."))
|
||||
(do (hs-emit! "op" ".." start) (hs-advance! 2) (scan!))
|
||||
(and
|
||||
(= ch ".")
|
||||
(< (+ pos 1) src-len)
|
||||
(or (hs-letter? (hs-peek 1)) (= (hs-peek 1) "-") (= (hs-peek 1) "_"))
|
||||
(> (len tokens) 0)
|
||||
(let
|
||||
((lt (dict-get (nth tokens (- (len tokens) 1)) :type)))
|
||||
(or (= lt "paren-close") (= lt "brace-close") (= lt "bracket-close"))))
|
||||
(do (hs-emit! "dot" "." start) (hs-advance! 1) (scan!))
|
||||
(and
|
||||
(= ch ".")
|
||||
(< (+ pos 1) src-len)
|
||||
@@ -521,15 +472,6 @@
|
||||
(hs-advance! 1)
|
||||
(hs-emit! "class" (read-class-name pos) start)
|
||||
(scan!))
|
||||
(and
|
||||
(= ch "#")
|
||||
(< (+ pos 1) src-len)
|
||||
(hs-ident-start? (hs-peek 1))
|
||||
(> (len tokens) 0)
|
||||
(let
|
||||
((lt (dict-get (nth tokens (- (len tokens) 1)) :type)))
|
||||
(or (= lt "paren-close") (= lt "brace-close") (= lt "bracket-close"))))
|
||||
(do (hs-emit! "op" "#" start) (hs-advance! 1) (scan!))
|
||||
(and
|
||||
(= ch "#")
|
||||
(< (+ pos 1) src-len)
|
||||
@@ -598,26 +540,10 @@
|
||||
(do
|
||||
(let
|
||||
((word (read-ident start)))
|
||||
(let
|
||||
((full-word
|
||||
(if
|
||||
(and
|
||||
(< pos src-len)
|
||||
(= (hs-cur) "'")
|
||||
(< (+ pos 1) src-len)
|
||||
(hs-letter? (hs-peek 1))
|
||||
(not
|
||||
(and
|
||||
(= (hs-peek 1) "s")
|
||||
(or
|
||||
(>= (+ pos 2) src-len)
|
||||
(not (hs-ident-char? (hs-peek 2)))))))
|
||||
(do (hs-advance! 1) (str word "'" (read-ident pos)))
|
||||
word)))
|
||||
(hs-emit!
|
||||
(if (hs-keyword? full-word) "keyword" "ident")
|
||||
full-word
|
||||
start)))
|
||||
(hs-emit!
|
||||
(if (hs-keyword? word) "keyword" "ident")
|
||||
word
|
||||
start))
|
||||
(scan!))
|
||||
(and
|
||||
(or (= ch "=") (= ch "!") (= ch "<") (= ch ">"))
|
||||
@@ -698,82 +624,7 @@
|
||||
(do (hs-emit! "colon" ":" start) (hs-advance! 1) (scan!))
|
||||
(= ch "|")
|
||||
(do (hs-emit! "op" "|" start) (hs-advance! 1) (scan!))
|
||||
(= ch "&")
|
||||
(do (hs-emit! "op" "&" start) (hs-advance! 1) (scan!))
|
||||
(= ch "#")
|
||||
(do (hs-emit! "op" "#" start) (hs-advance! 1) (scan!))
|
||||
(= ch "?")
|
||||
(do (hs-emit! "op" "?" start) (hs-advance! 1) (scan!))
|
||||
(= ch ";")
|
||||
(do (hs-emit! "op" ";" start) (hs-advance! 1) (scan!))
|
||||
:else (do (hs-advance! 1) (scan!)))))))
|
||||
(scan!)
|
||||
(hs-emit! "eof" nil pos)
|
||||
tokens)))
|
||||
|
||||
;; ── Template-mode tokenizer (E37 API) ────────────────────────────────
|
||||
;; Used by hs-tokens-of when :template flag is set.
|
||||
;; Emits outer " chars as single STRING tokens; ${ ... } as $ { <inner-tokens> };
|
||||
;; inner content is tokenized with the regular hs-tokenize.
|
||||
|
||||
(define
|
||||
hs-tokenize-template
|
||||
(fn
|
||||
(src)
|
||||
(let
|
||||
((tokens (list)) (pos 0) (src-len (len src)))
|
||||
(define t-cur (fn () (if (< pos src-len) (nth src pos) nil)))
|
||||
(define t-peek (fn (n) (if (< (+ pos n) src-len) (nth src (+ pos n)) nil)))
|
||||
(define t-advance! (fn (n) (set! pos (+ pos n))))
|
||||
(define t-emit! (fn (type value) (append! tokens (hs-make-token type value pos))))
|
||||
(define
|
||||
scan-to-close!
|
||||
(fn
|
||||
(depth)
|
||||
(when
|
||||
(and (< pos src-len) (> depth 0))
|
||||
(cond
|
||||
(= (t-cur) "{")
|
||||
(do (t-advance! 1) (scan-to-close! (+ depth 1)))
|
||||
(= (t-cur) "}")
|
||||
(when (> (- depth 1) 0) (t-advance! 1) (scan-to-close! (- depth 1)))
|
||||
:else (do (t-advance! 1) (scan-to-close! depth))))))
|
||||
(define
|
||||
scan-template!
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(< pos src-len)
|
||||
(let
|
||||
((ch (t-cur)))
|
||||
(cond
|
||||
(= ch "\"")
|
||||
(do (t-emit! "string" "\"") (t-advance! 1) (scan-template!))
|
||||
(and (= ch "$") (= (t-peek 1) "{"))
|
||||
(do
|
||||
(t-emit! "op" "$")
|
||||
(t-advance! 1)
|
||||
(t-emit! "brace-open" "{")
|
||||
(t-advance! 1)
|
||||
(let
|
||||
((inner-start pos))
|
||||
(scan-to-close! 1)
|
||||
(let
|
||||
((inner-src (slice src inner-start pos))
|
||||
(inner-toks (hs-tokenize inner-src)))
|
||||
(for-each
|
||||
(fn (tok)
|
||||
(when (not (= (get tok "type") "eof"))
|
||||
(append! tokens tok)))
|
||||
inner-toks))
|
||||
(t-emit! "brace-close" "}")
|
||||
(when (< pos src-len) (t-advance! 1)))
|
||||
(scan-template!))
|
||||
(= ch "$")
|
||||
(do (t-emit! "op" "$") (t-advance! 1) (scan-template!))
|
||||
(hs-ws? ch)
|
||||
(do (t-advance! 1) (scan-template!))
|
||||
:else (do (t-advance! 1) (scan-template!)))))))
|
||||
(scan-template!)
|
||||
(t-emit! "eof" nil)
|
||||
tokens)))
|
||||
File diff suppressed because one or more lines are too long
@@ -46045,7 +46045,7 @@ d2=133,bi=102,bh="Re__Hash_set",cA="Stdlib__Type",cB=114,fF="Stdlib__Buffer",dX=
|
||||
}
|
||||
return trampoline(eval_expr(Sx_types[75].call(null, mac), local));
|
||||
}
|
||||
var step_limit = [0, 0], step_count = [0, 0], _wc_check = 0;
|
||||
var step_limit = [0, 0], step_count = [0, 0];
|
||||
function cek_step_loop(state$0){
|
||||
var state = state$0;
|
||||
for(;;){
|
||||
@@ -46055,11 +46055,6 @@ d2=133,bi=102,bh="Re__Hash_set",cA="Stdlib__Type",cB=114,fF="Stdlib__Buffer",dX=
|
||||
throw caml_maybe_attach_backtrace
|
||||
([0, Sx_types[9], "TIMEOUT: step limit exceeded"], 1);
|
||||
}
|
||||
if(++_wc_check >= 10000){ _wc_check = 0;
|
||||
if(globalThis.__hs_deadline && Date.now() > globalThis.__hs_deadline)
|
||||
throw caml_maybe_attach_backtrace
|
||||
([0, Sx_types[9], "TIMEOUT: wall clock exceeded"], 1);
|
||||
}
|
||||
var
|
||||
or = cek_terminal_p(state),
|
||||
or$0 = Sx_types[56].call(null, or) ? or : cek_suspended_p(state);
|
||||
|
||||
@@ -93,17 +93,6 @@
|
||||
(raise _e))))
|
||||
(handler me-val))))))
|
||||
|
||||
;; Evaluate a HS expression using evalStatically semantics:
|
||||
;; only literal values (numbers, strings, booleans, null, time units)
|
||||
;; succeed — any other expression raises "cannot be evaluated statically".
|
||||
(define hs-eval-statically
|
||||
(fn (src)
|
||||
(let ((ast (hs-compile src)))
|
||||
(if (or (number? ast) (string? ast) (boolean? ast)
|
||||
(and (list? ast) (= (first ast) (quote null-literal))))
|
||||
(eval-hs src)
|
||||
(raise "cannot be evaluated statically")))))
|
||||
|
||||
;; ── add (19 tests) ──
|
||||
(defsuite "hs-upstream-add"
|
||||
(deftest "can add a value to a set"
|
||||
@@ -1134,11 +1123,9 @@
|
||||
;; ── breakpoint (2 tests) ──
|
||||
(defsuite "hs-upstream-breakpoint"
|
||||
(deftest "parses as a top-level command"
|
||||
(hs-compile "breakpoint")
|
||||
)
|
||||
(error "SKIP (untranslated): parses as a top-level command"))
|
||||
(deftest "parses inside an event handler"
|
||||
(hs-compile "on click breakpoint end")
|
||||
)
|
||||
(error "SKIP (untranslated): parses inside an event handler"))
|
||||
)
|
||||
|
||||
;; ── call (6 tests) ──
|
||||
@@ -1246,14 +1233,13 @@
|
||||
(defsuite "hs-upstream-core/bootstrap"
|
||||
(deftest "can call functions"
|
||||
(hs-cleanup!)
|
||||
(host-set! (host-global "window") "calledWith" nil)
|
||||
(host-set! (host-global "window") "calledWith" null)
|
||||
(let ((_el-div (dom-create-element "div")))
|
||||
(dom-set-attr _el-div "_" "on click call globalFunction(\"foo\")")
|
||||
(dom-append (dom-body) _el-div)
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
)
|
||||
)
|
||||
))
|
||||
(deftest "can change non-class properties"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-div (dom-create-element "div")))
|
||||
@@ -1397,11 +1383,8 @@
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
(assert (dom-has-class? _el-div "foo"))
|
||||
(hs-deactivate! _el-div)
|
||||
(dom-remove-class _el-div "foo")
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
(assert (not (dom-has-class? _el-div "foo"))))
|
||||
)
|
||||
(assert (not (dom-has-class? _el-div "foo")))
|
||||
))
|
||||
(deftest "cleanup tracks listeners in elt._hyperscript"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-div (dom-create-element "div")))
|
||||
@@ -1482,11 +1465,9 @@
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
(assert (dom-has-class? _el-div "foo"))
|
||||
(dom-set-attr _el-div "_" "on click add .bar")
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
(assert (dom-has-class? _el-div "bar")))
|
||||
)
|
||||
(assert (dom-has-class? _el-div "bar"))
|
||||
))
|
||||
(deftest "sets data-hyperscript-powered on initialized elements"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-div (dom-create-element "div")))
|
||||
@@ -1605,14 +1586,11 @@
|
||||
;; ── core/evalStatically (8 tests) ──
|
||||
(defsuite "hs-upstream-core/evalStatically"
|
||||
(deftest "throws on math expressions"
|
||||
(guard (_e (true nil)) (hs-eval-statically "1 + 2") (error "hs-eval-statically did not throw for: 1 + 2"))
|
||||
)
|
||||
(error "SKIP (untranslated): throws on math expressions"))
|
||||
(deftest "throws on symbol references"
|
||||
(guard (_e (true nil)) (hs-eval-statically "x") (error "hs-eval-statically did not throw for: x"))
|
||||
)
|
||||
(error "SKIP (untranslated): throws on symbol references"))
|
||||
(deftest "throws on template strings"
|
||||
(guard (_e (true nil)) (hs-eval-statically "`hello ${name}`") (error "hs-eval-statically did not throw for: `hello ${name}`"))
|
||||
)
|
||||
(error "SKIP (untranslated): throws on template strings"))
|
||||
(deftest "works on boolean literals"
|
||||
(assert= (eval-hs "true") true)
|
||||
(assert= (eval-hs "false") false)
|
||||
@@ -2014,8 +1992,8 @@
|
||||
(dom-set-attr _el-d2 "id" "d2")
|
||||
(dom-set-attr _el-div "_" "on click make a <p/> then put #i1.value into its textContent put it.outerHTML at end of #d2")
|
||||
(dom-append (dom-body) _el-i1)
|
||||
(dom-append (dom-body) _el-d2)
|
||||
(dom-append (dom-body) _el-div)
|
||||
(dom-append _el-i1 _el-d2)
|
||||
(dom-append _el-i1 _el-div)
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch (dom-query "div:nth-of-type(2)") "click" nil)
|
||||
))
|
||||
@@ -2030,20 +2008,7 @@
|
||||
(assert= (dom-text-content _el-button) "select2")
|
||||
))
|
||||
(deftest "can pick detail fields out by name"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-d1 (dom-create-element "div")) (_el-d2 (dom-create-element "div")))
|
||||
(dom-set-attr _el-d1 "id" "d1")
|
||||
(dom-set-attr _el-d1 "_" "on click send custom(foo:\"fromBar\") to #d2")
|
||||
(dom-set-attr _el-d2 "id" "d2")
|
||||
(dom-set-attr _el-d2 "_" "on custom(foo) call me.classList.add(foo)")
|
||||
(dom-append (dom-body) _el-d1)
|
||||
(dom-append (dom-body) _el-d2)
|
||||
(hs-activate! _el-d1)
|
||||
(hs-activate! _el-d2)
|
||||
(assert (not (dom-has-class? _el-d2 "fromBar")))
|
||||
(dom-dispatch _el-d1 "click" nil)
|
||||
(assert (dom-has-class? _el-d2 "fromBar")))
|
||||
)
|
||||
(error "SKIP (skip-list): can pick detail fields out by name"))
|
||||
(deftest "can refer to function in init blocks"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-d1 (dom-create-element "div")))
|
||||
@@ -2502,314 +2467,53 @@
|
||||
;; ── core/sourceInfo (4 tests) ──
|
||||
(defsuite "hs-upstream-core/sourceInfo"
|
||||
(deftest "debug"
|
||||
(assert= (hs-src "<button.foo/>") "<button.foo/>"))
|
||||
(error "SKIP (untranslated): debug"))
|
||||
(deftest "get line works for statements"
|
||||
(assert= (hs-line-at "if true\n log 'it was true'\n log 'it was true'" (list)) "if true")
|
||||
(assert= (hs-line-at "if true\n log 'it was true'\n log 'it was true'" (list :true-branch)) " log 'it was true'")
|
||||
(assert= (hs-line-at "if true\n log 'it was true'\n log 'it was true'" (list :true-branch :next)) " log 'it was true'"))
|
||||
(error "SKIP (untranslated): get line works for statements"))
|
||||
(deftest "get source works for expressions"
|
||||
(assert= (hs-src "1") "1")
|
||||
(assert= (hs-src "a.b") "a.b")
|
||||
(assert= (hs-src-at "a.b" (list :root)) "a")
|
||||
(assert= (hs-src "a.b()") "a.b()")
|
||||
(assert= (hs-src-at "a.b()" (list :root)) "a.b")
|
||||
(assert= (hs-src-at "a.b()" (list :root :root)) "a")
|
||||
(assert= (hs-src "<button.foo/>") "<button.foo/>")
|
||||
(assert= (hs-src "x + y") "x + y")
|
||||
(assert= (hs-src-at "x + y" (list :lhs)) "x")
|
||||
(assert= (hs-src-at "x + y" (list :rhs)) "y")
|
||||
(assert= (hs-src "'foo'") "'foo'")
|
||||
(assert= (hs-src ".foo") ".foo")
|
||||
(assert= (hs-src "#bar") "#bar"))
|
||||
(error "SKIP (untranslated): get source works for expressions"))
|
||||
(deftest "get source works for statements"
|
||||
(assert= (hs-src "if true log 'it was true'") "if true log 'it was true'")
|
||||
(assert= (hs-src "for x in [1, 2, 3] log x then log x end") "for x in [1, 2, 3] log x then log x end"))
|
||||
(error "SKIP (untranslated): get source works for statements"))
|
||||
)
|
||||
|
||||
;; ── core/tokenizer (17 tests) ──
|
||||
(defsuite "hs-upstream-core/tokenizer"
|
||||
(deftest "handles $ in template properly"
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"" :template) 0)) "\"")
|
||||
)
|
||||
(error "SKIP (untranslated): handles $ in template properly"))
|
||||
(deftest "handles all special escapes properly"
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\b\""))) (char-from-code 8))
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\f\""))) (char-from-code 12))
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\n\""))) "\n")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\r\""))) "\r")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\t\""))) "\t")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\v\""))) (char-from-code 11))
|
||||
)
|
||||
(error "SKIP (untranslated): handles all special escapes properly"))
|
||||
(deftest "handles basic token types"
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "foo"))) "IDENTIFIER")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1"))) "NUMBER")
|
||||
(let ((s (hs-tokens-of "1.1")))
|
||||
(let ((tok (hs-stream-consume s)))
|
||||
(assert= (hs-token-type tok) "NUMBER")
|
||||
(assert= (hs-stream-has-more s) false)))
|
||||
(let ((s (hs-tokens-of "1e6")))
|
||||
(let ((tok (hs-stream-consume s)))
|
||||
(assert= (hs-token-type tok) "NUMBER")
|
||||
(assert= (hs-stream-has-more s) false)))
|
||||
(let ((s (hs-tokens-of "1e-6")))
|
||||
(let ((tok (hs-stream-consume s)))
|
||||
(assert= (hs-token-type tok) "NUMBER")
|
||||
(assert= (hs-stream-has-more s) false)))
|
||||
(let ((s (hs-tokens-of "1.1e6")))
|
||||
(let ((tok (hs-stream-consume s)))
|
||||
(assert= (hs-token-type tok) "NUMBER")
|
||||
(assert= (hs-stream-has-more s) false)))
|
||||
(let ((s (hs-tokens-of "1.1e-6")))
|
||||
(let ((tok (hs-stream-consume s)))
|
||||
(assert= (hs-token-type tok) "NUMBER")
|
||||
(assert= (hs-stream-has-more s) false)))
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of ".a"))) "CLASS_REF")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "#a"))) "ID_REF")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "\"asdf\""))) "STRING")
|
||||
)
|
||||
(error "SKIP (untranslated): handles basic token types"))
|
||||
(deftest "handles class identifiers properly"
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of ".a"))) "CLASS_REF")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of ".a"))) ".a")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of " .a"))) "CLASS_REF")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of " .a"))) ".a")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "a.a"))) "IDENTIFIER")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "a.a"))) "a")
|
||||
(assert= (hs-token-type (nth (get (hs-tokens-of "(a).a") "list") 4)) "IDENTIFIER")
|
||||
(assert= (hs-token-value (nth (get (hs-tokens-of "(a).a") "list") 4)) "a")
|
||||
(assert= (hs-token-type (nth (get (hs-tokens-of "{a}.a") "list") 4)) "IDENTIFIER")
|
||||
(assert= (hs-token-value (nth (get (hs-tokens-of "{a}.a") "list") 4)) "a")
|
||||
(assert= (hs-token-type (nth (get (hs-tokens-of "[a].a") "list") 4)) "IDENTIFIER")
|
||||
(assert= (hs-token-value (nth (get (hs-tokens-of "[a].a") "list") 4)) "a")
|
||||
(assert= (hs-token-type (nth (get (hs-tokens-of "(a(.a") "list") 3)) "CLASS_REF")
|
||||
(assert= (hs-token-value (nth (get (hs-tokens-of "(a(.a") "list") 3)) ".a")
|
||||
(assert= (hs-token-type (nth (get (hs-tokens-of "{a{.a") "list") 3)) "CLASS_REF")
|
||||
(assert= (hs-token-value (nth (get (hs-tokens-of "{a{.a") "list") 3)) ".a")
|
||||
(assert= (hs-token-type (nth (get (hs-tokens-of "[a[.a") "list") 3)) "CLASS_REF")
|
||||
(assert= (hs-token-value (nth (get (hs-tokens-of "[a[.a") "list") 3)) ".a")
|
||||
)
|
||||
(error "SKIP (untranslated): handles class identifiers properly"))
|
||||
(deftest "handles comments properly"
|
||||
(assert= (len (get (hs-tokens-of "--") "list")) 0)
|
||||
(assert= (len (get (hs-tokens-of "asdf--") "list")) 1)
|
||||
(assert= (len (get (hs-tokens-of "-- asdf") "list")) 0)
|
||||
(assert= (len (get (hs-tokens-of "--\nasdf") "list")) 1)
|
||||
(assert= (len (get (hs-tokens-of "--\nasdf--") "list")) 1)
|
||||
(assert= (len (get (hs-tokens-of "---asdf") "list")) 0)
|
||||
(assert= (len (get (hs-tokens-of "----\n---asdf") "list")) 0)
|
||||
(assert= (len (get (hs-tokens-of "----asdf----") "list")) 0)
|
||||
(assert= (len (get (hs-tokens-of "---\nasdf---") "list")) 1)
|
||||
(assert= (len (get (hs-tokens-of "// asdf") "list")) 0)
|
||||
(assert= (len (get (hs-tokens-of "///asdf") "list")) 0)
|
||||
(assert= (len (get (hs-tokens-of "asdf//") "list")) 1)
|
||||
(assert= (len (get (hs-tokens-of "asdf\n//") "list")) 2)
|
||||
)
|
||||
(error "SKIP (untranslated): handles comments properly"))
|
||||
(deftest "handles hex escapes properly"
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\x1f\""))) (char-from-code 31))
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\x41\""))) "A")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\x41\\x61\""))) "Aa")
|
||||
(let ((threw false))
|
||||
(guard (e (true (set! threw true))) (hs-stream-consume (hs-tokens-of "\"\\x\"")))
|
||||
(assert threw))
|
||||
(let ((threw false))
|
||||
(guard (e (true (set! threw true))) (hs-stream-consume (hs-tokens-of "\"\\xGG\"")))
|
||||
(assert threw))
|
||||
(let ((threw false))
|
||||
(guard (e (true (set! threw true))) (hs-stream-consume (hs-tokens-of "\"\\x4\"")))
|
||||
(assert threw))
|
||||
)
|
||||
(error "SKIP (untranslated): handles hex escapes properly"))
|
||||
(deftest "handles id references properly"
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "#a"))) "ID_REF")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "#a"))) "#a")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of " #a"))) "ID_REF")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of " #a"))) "#a")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "a#a"))) "IDENTIFIER")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "a#a"))) "a")
|
||||
(assert= (hs-token-type (nth (get (hs-tokens-of "(a)#a") "list") 4)) "IDENTIFIER")
|
||||
(assert= (hs-token-value (nth (get (hs-tokens-of "(a)#a") "list") 4)) "a")
|
||||
(assert= (hs-token-type (nth (get (hs-tokens-of "{a}#a") "list") 4)) "IDENTIFIER")
|
||||
(assert= (hs-token-value (nth (get (hs-tokens-of "{a}#a") "list") 4)) "a")
|
||||
(assert= (hs-token-type (nth (get (hs-tokens-of "[a]#a") "list") 4)) "IDENTIFIER")
|
||||
(assert= (hs-token-value (nth (get (hs-tokens-of "[a]#a") "list") 4)) "a")
|
||||
(assert= (hs-token-type (nth (get (hs-tokens-of "(a(#a") "list") 3)) "ID_REF")
|
||||
(assert= (hs-token-value (nth (get (hs-tokens-of "(a(#a") "list") 3)) "#a")
|
||||
(assert= (hs-token-type (nth (get (hs-tokens-of "{a{#a") "list") 3)) "ID_REF")
|
||||
(assert= (hs-token-value (nth (get (hs-tokens-of "{a{#a") "list") 3)) "#a")
|
||||
(assert= (hs-token-type (nth (get (hs-tokens-of "[a[#a") "list") 3)) "ID_REF")
|
||||
(assert= (hs-token-value (nth (get (hs-tokens-of "[a[#a") "list") 3)) "#a")
|
||||
)
|
||||
(error "SKIP (untranslated): handles id references properly"))
|
||||
(deftest "handles identifiers properly"
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "foo"))) "IDENTIFIER")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "foo"))) "foo")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of " foo "))) "IDENTIFIER")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of " foo "))) "foo")
|
||||
(let ((s (hs-tokens-of " foo bar")))
|
||||
(let ((tok1 (hs-stream-consume s)))
|
||||
(assert= (hs-token-type tok1) "IDENTIFIER")
|
||||
(assert= (hs-token-value tok1) "foo")
|
||||
(let ((tok2 (hs-stream-consume s)))
|
||||
(assert= (hs-token-type tok2) "IDENTIFIER")
|
||||
(assert= (hs-token-value tok2) "bar"))))
|
||||
(let ((s (hs-tokens-of " foo\n-- a comment\n bar")))
|
||||
(let ((tok1 (hs-stream-consume s)))
|
||||
(assert= (hs-token-type tok1) "IDENTIFIER")
|
||||
(assert= (hs-token-value tok1) "foo")
|
||||
(let ((tok2 (hs-stream-consume s)))
|
||||
(assert= (hs-token-type tok2) "IDENTIFIER")
|
||||
(assert= (hs-token-value tok2) "bar"))))
|
||||
)
|
||||
(error "SKIP (untranslated): handles identifiers properly"))
|
||||
(deftest "handles identifiers with numbers properly"
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "f1oo"))) "IDENTIFIER")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "f1oo"))) "f1oo")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "fo1o"))) "IDENTIFIER")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "fo1o"))) "fo1o")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "foo1"))) "IDENTIFIER")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "foo1"))) "foo1")
|
||||
)
|
||||
(error "SKIP (untranslated): handles identifiers with numbers properly"))
|
||||
(deftest "handles look ahead property"
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "a 1 + 1") 0)) "a")
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "a 1 + 1") 1)) "1")
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "a 1 + 1") 2)) "+")
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "a 1 + 1") 3)) "1")
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "a 1 + 1") 4)) "<<<EOF>>>")
|
||||
)
|
||||
(error "SKIP (untranslated): handles look ahead property"))
|
||||
(deftest "handles numbers properly"
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1"))) "NUMBER")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1"))) "1")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1.1"))) "NUMBER")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1.1"))) "1.1")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1234567890.1234567890"))) "NUMBER")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1234567890.1234567890"))) "1234567890.1234567890")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1e6"))) "NUMBER")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1e6"))) "1e6")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1e-6"))) "NUMBER")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1e-6"))) "1e-6")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1.1e6"))) "NUMBER")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1.1e6"))) "1.1e6")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1.1e-6"))) "NUMBER")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1.1e-6"))) "1.1e-6")
|
||||
(assert= (hs-token-type (nth (get (hs-tokens-of "1.1.1") "list") 0)) "NUMBER")
|
||||
(assert= (hs-token-type (nth (get (hs-tokens-of "1.1.1") "list") 1)) "PERIOD")
|
||||
(assert= (hs-token-type (nth (get (hs-tokens-of "1.1.1") "list") 2)) "NUMBER")
|
||||
(assert= (len (get (hs-tokens-of "1.1.1") "list")) 3)
|
||||
)
|
||||
(error "SKIP (untranslated): handles numbers properly"))
|
||||
(deftest "handles operators properly"
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "+"))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "+"))) "+")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "-"))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "-"))) "-")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "*"))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "*"))) "*")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "."))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "."))) ".")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "\\"))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\\"))) "\\")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of ":"))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of ":"))) ":")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "%"))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "%"))) "%")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "|"))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "|"))) "|")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "!"))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "!"))) "!")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "?"))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "?"))) "?")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "#"))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "#"))) "#")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "&"))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "&"))) "&")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of ";"))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of ";"))) ";")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of ","))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of ","))) ",")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "("))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "("))) "(")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of ")"))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of ")"))) ")")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "<"))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "<"))) "<")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of ">"))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of ">"))) ">")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "{"))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "{"))) "{")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "}"))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "}"))) "}")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "["))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "["))) "[")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "]"))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "]"))) "]")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "="))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "="))) "=")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "<="))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "<="))) "<=")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of ">="))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of ">="))) ">=")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "=="))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "=="))) "==")
|
||||
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "==="))) true)
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "==="))) "===")
|
||||
)
|
||||
(error "SKIP (untranslated): handles operators properly"))
|
||||
(deftest "handles strings properly"
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "\"foo\""))) "STRING")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"foo\""))) "foo")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "\"fo'o\""))) "STRING")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"fo'o\""))) "fo'o")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "\"fo\\\"o\""))) "STRING")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"fo\\\"o\""))) "fo\"o")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "'foo'"))) "STRING")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "'foo'"))) "foo")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "'fo\"o'"))) "STRING")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "'fo\"o'"))) "fo\"o")
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "'fo\\'o'"))) "STRING")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "'fo\\'o'"))) "fo'o")
|
||||
(let ((threw false))
|
||||
(guard (e (true (set! threw true))) (hs-stream-consume (hs-tokens-of "'")))
|
||||
(assert threw))
|
||||
(let ((threw false))
|
||||
(guard (e (true (set! threw true))) (hs-stream-consume (hs-tokens-of "\"")))
|
||||
(assert threw))
|
||||
)
|
||||
(error "SKIP (untranslated): handles strings properly"))
|
||||
(deftest "handles strings properly 2"
|
||||
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "'foo'"))) "STRING")
|
||||
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "'foo'"))) "foo")
|
||||
)
|
||||
(error "SKIP (untranslated): handles strings properly 2"))
|
||||
(deftest "handles template bootstrap properly"
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"" :template) 0)) "\"")
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"$" :template) 0)) "\"")
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"$" :template) 1)) "$")
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${" :template) 0)) "\"")
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${" :template) 1)) "$")
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${" :template) 2)) "{")
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"" :template) 0)) "\"")
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"" :template) 1)) "$")
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"" :template) 2)) "{")
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"" :template) 3)) "asdf")
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"}\"" :template) 0)) "\"")
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"}\"" :template) 1)) "$")
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"}\"" :template) 2)) "{")
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"}\"" :template) 3)) "asdf")
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"}\"" :template) 4)) "}")
|
||||
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"}\"" :template) 5)) "\"")
|
||||
)
|
||||
(error "SKIP (untranslated): handles template bootstrap properly"))
|
||||
(deftest "handles whitespace properly"
|
||||
(assert= (len (get (hs-tokens-of " ") "list")) 0)
|
||||
(assert= (len (get (hs-tokens-of " asdf") "list")) 1)
|
||||
(assert= (len (get (hs-tokens-of " asdf ") "list")) 2)
|
||||
(assert= (len (get (hs-tokens-of "asdf ") "list")) 2)
|
||||
(assert= (len (get (hs-tokens-of "\n") "list")) 0)
|
||||
(assert= (len (get (hs-tokens-of "\nasdf") "list")) 1)
|
||||
(assert= (len (get (hs-tokens-of "\nasdf\n") "list")) 2)
|
||||
(assert= (len (get (hs-tokens-of "asdf\n") "list")) 2)
|
||||
(assert= (len (get (hs-tokens-of "\r") "list")) 0)
|
||||
(assert= (len (get (hs-tokens-of "\rasdf") "list")) 1)
|
||||
(assert= (len (get (hs-tokens-of "\rasdf\r") "list")) 2)
|
||||
(assert= (len (get (hs-tokens-of "asdf\r") "list")) 2)
|
||||
(assert= (len (get (hs-tokens-of "\t") "list")) 0)
|
||||
(assert= (len (get (hs-tokens-of "\tasdf") "list")) 1)
|
||||
(assert= (len (get (hs-tokens-of "\tasdf\t") "list")) 2)
|
||||
(assert= (len (get (hs-tokens-of "asdf\t") "list")) 2)
|
||||
)
|
||||
(error "SKIP (untranslated): handles whitespace properly"))
|
||||
(deftest "string interpolation isnt surprising"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-div (dom-create-element "div")))
|
||||
(dom-set-attr _el-div "_" "on click set x to 42 then put `test\\${x} test ${x} test\\$x test $x test \\$x test \\${x} test$x test_$x test_${x} test-$x test.$x` into my.innerHTML")
|
||||
(dom-set-attr _el-div "_" "on click set x to 42 then put `test${x} test ${x} test$x test $x test $x test ${x} test$x test_$x test_${x} test-$x test.$x` into my.innerHTML")
|
||||
(dom-append (dom-body) _el-div)
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
@@ -3657,7 +3361,7 @@
|
||||
(assert= (eval-hs "[1 + 1, 2 * 3, 10 - 5]") (list 2 6 5))
|
||||
)
|
||||
(deftest "arrays containing objects work"
|
||||
(assert-equal (list {:a 1} {:b 2}) (eval-hs "[{a: 1}, {b: 2}]"))
|
||||
(assert= (eval-hs "[{a: 1}, {b: 2}]") (list {:a 1} {:b 2}))
|
||||
)
|
||||
(deftest "deeply nested array literals work"
|
||||
(assert= (eval-hs "[[[1]], [[2, 3]]]") (list (list (list 1)) (list (list 2 3))))
|
||||
@@ -3760,11 +3464,11 @@
|
||||
(dom-set-attr _el-input6 "value" "555-1212")
|
||||
(dom-append (dom-body) _el-qsdiv)
|
||||
(dom-append _el-qsdiv _el-input)
|
||||
(dom-append _el-qsdiv _el-br)
|
||||
(dom-append _el-qsdiv _el-input3)
|
||||
(dom-append _el-qsdiv _el-br4)
|
||||
(dom-append _el-qsdiv _el-input5)
|
||||
(dom-append _el-qsdiv _el-input6)
|
||||
(dom-append _el-input _el-br)
|
||||
(dom-append _el-br _el-input3)
|
||||
(dom-append _el-input3 _el-br4)
|
||||
(dom-append _el-br4 _el-input5)
|
||||
(dom-append _el-input5 _el-input6)
|
||||
(hs-activate! _el-qsdiv)
|
||||
))
|
||||
(deftest "converts an array into HTML"
|
||||
@@ -3817,15 +3521,11 @@
|
||||
)
|
||||
(deftest "converts multiple selects with programmatically changed selections"
|
||||
(let ((_node (dom-create-element "form")))
|
||||
(dom-set-inner-html _node "<select name="animal" multiple> <option value="dog" selected>Doggo</option> <option value="cat">Kitteh</option> <option value="raccoon" selected>Trash Panda</option> <option value="possum">Sleepy Boi</option> </select>")
|
||||
(let ((_sel (dom-query _node "select")))
|
||||
(let ((_opts (host-get _sel "options")))
|
||||
(host-set! (nth _opts 0) "selected" false)
|
||||
(host-set! (nth _opts 1) "selected" true)
|
||||
(let ((_result (eval-hs-locals "x as Values" (list (list (quote x) _node)))))
|
||||
(assert= (nth (host-get _result "animal") 0) "cat")
|
||||
(assert= (nth (host-get _result "animal") 1) "raccoon")
|
||||
))))
|
||||
(dom-set-inner-html _node "<select name=\"animal\" multiple> <option value=\"dog\" selected>Doggo</option> <option value=\"cat\">Kitteh</option> <option value=\"raccoon\" selected>Trash Panda</option> <option value=\"possum\">Sleepy Boi</option> </select>")
|
||||
(let ((_result (eval-hs-locals "x as Values" (list (list (quote x) _node)))))
|
||||
(assert= (nth (host-get _result "animal") 0) "cat")
|
||||
(assert= (nth (host-get _result "animal") 1) "raccoon")
|
||||
))
|
||||
)
|
||||
(deftest "converts nested array as Flat"
|
||||
(assert= (eval-hs "[[1,2],[3,4]] as Flat") (list 1 2 3 4))
|
||||
@@ -3927,7 +3627,8 @@
|
||||
(dom-append (dom-body) _el-button)
|
||||
(hs-activate! _el-button)
|
||||
(dom-dispatch _el-button "click" nil)
|
||||
(assert= (dom-text-content (dom-query-by-id "target")) "new")))
|
||||
(assert= (dom-text-content (dom-query-by-id "target")) "new")
|
||||
))
|
||||
(deftest "set #id replaces element with HTML string"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-target (dom-create-element "div")) (_el-button (dom-create-element "button")))
|
||||
@@ -4252,17 +3953,13 @@
|
||||
;; ── expressions/blockLiteral (4 tests) ──
|
||||
(defsuite "hs-upstream-expressions/blockLiteral"
|
||||
(deftest "basic block literals work"
|
||||
(assert= (apply (eval-expr-cek (hs-to-sx (hs-compile "\\ -> true"))) (list)) true)
|
||||
)
|
||||
(error "SKIP (untranslated): basic block literals work"))
|
||||
(deftest "basic identity works"
|
||||
(assert= (apply (eval-expr-cek (hs-to-sx (hs-compile "\\ x -> x"))) (list true)) true)
|
||||
)
|
||||
(error "SKIP (untranslated): basic identity works"))
|
||||
(deftest "basic two arg identity works"
|
||||
(assert= (apply (eval-expr-cek (hs-to-sx (hs-compile "\\ x, y -> y"))) (list false true)) true)
|
||||
)
|
||||
(error "SKIP (untranslated): basic two arg identity works"))
|
||||
(deftest "can map an array"
|
||||
(assert= (map (eval-expr-cek (hs-to-sx (hs-compile "\\ s -> s.length"))) (list "a" "ab" "abc")) (list 1 2 3))
|
||||
)
|
||||
(error "SKIP (untranslated): can map an array"))
|
||||
)
|
||||
|
||||
;; ── expressions/boolean (2 tests) ──
|
||||
@@ -4399,9 +4096,9 @@
|
||||
(dom-append _el-table _el-tr)
|
||||
(dom-append _el-tr _el-td)
|
||||
(dom-append _el-td _el-input)
|
||||
(dom-append _el-td _el-input4)
|
||||
(dom-append _el-td _el-master)
|
||||
(dom-append (dom-body) _el-out)
|
||||
(dom-append _el-input _el-input4)
|
||||
(dom-append _el-input4 _el-master)
|
||||
(dom-append _el-master _el-out)
|
||||
(hs-activate! _el-master)
|
||||
(dom-dispatch (dom-query-by-id "master") "click" nil)
|
||||
(assert= (dom-text-content (dom-query-by-id "out")) "2")
|
||||
@@ -4482,13 +4179,13 @@
|
||||
(dom-append _el-table _el-tr)
|
||||
(dom-append _el-tr _el-td)
|
||||
(dom-append _el-td _el-input)
|
||||
(dom-append _el-table _el-tr4)
|
||||
(dom-append _el-input _el-tr4)
|
||||
(dom-append _el-tr4 _el-td5)
|
||||
(dom-append _el-td5 _el-input6)
|
||||
(dom-append _el-table _el-tr7)
|
||||
(dom-append _el-input6 _el-tr7)
|
||||
(dom-append _el-tr7 _el-td8)
|
||||
(dom-append _el-td8 _el-input9)
|
||||
(dom-append _el-table _el-tr10)
|
||||
(dom-append _el-input9 _el-tr10)
|
||||
(dom-append _el-tr10 _el-td11)
|
||||
(dom-append _el-td11 _el-master)
|
||||
(hs-activate! _el-master)
|
||||
@@ -4670,13 +4367,13 @@
|
||||
(dom-append _el-table _el-tr)
|
||||
(dom-append _el-tr _el-td)
|
||||
(dom-append _el-td _el-input)
|
||||
(dom-append _el-table _el-tr4)
|
||||
(dom-append _el-input _el-tr4)
|
||||
(dom-append _el-tr4 _el-td5)
|
||||
(dom-append _el-td5 _el-input6)
|
||||
(dom-append _el-table _el-tr7)
|
||||
(dom-append _el-input6 _el-tr7)
|
||||
(dom-append _el-tr7 _el-td8)
|
||||
(dom-append _el-td8 _el-input9)
|
||||
(dom-append _el-table _el-tr10)
|
||||
(dom-append _el-input9 _el-tr10)
|
||||
(dom-append _el-tr10 _el-td11)
|
||||
(dom-append _el-td11 _el-master)
|
||||
(hs-activate! _el-master)
|
||||
@@ -4695,9 +4392,9 @@
|
||||
(dom-set-inner-html _el-script "<input type=\"checkbox\" _=\"set :checkboxes to <input[type=checkbox]/> in #box where it is not me on change set checked of the :checkboxes to my checked\">")
|
||||
(dom-append (dom-body) _el-box)
|
||||
(dom-append _el-box _el-input)
|
||||
(dom-append _el-box _el-input2)
|
||||
(dom-append (dom-body) _el-script)
|
||||
(dom-append (dom-body) _el-test-where-me)
|
||||
(dom-append _el-input _el-input2)
|
||||
(dom-append _el-input2 _el-script)
|
||||
(dom-append _el-input2 _el-test-where-me)
|
||||
(dom-dispatch (dom-query "test-where-me input") "click" nil)
|
||||
))
|
||||
(deftest "works with DOM elements"
|
||||
@@ -5246,17 +4943,7 @@
|
||||
(eval-hs "set cookies.foo to 'bar'")
|
||||
(assert= (eval-hs "cookies.foo") "bar"))
|
||||
(deftest "iterate cookies values work"
|
||||
(hs-cleanup!)
|
||||
(host-set! (host-global "cookies") "foo" "bar")
|
||||
(let ((_names (list)) (_values (list)))
|
||||
(hs-for-each
|
||||
(fn (x)
|
||||
(append! _names (host-get x "name"))
|
||||
(append! _values (host-get x "value")))
|
||||
(host-global "cookies"))
|
||||
(assert-contains "foo" _names)
|
||||
(assert-contains "bar" _values))
|
||||
)
|
||||
(error "SKIP (untranslated): iterate cookies values work"))
|
||||
(deftest "length is 0 when no cookies are set"
|
||||
(hs-cleanup!)
|
||||
(assert= (eval-hs "cookies.length") 0))
|
||||
@@ -5613,7 +5300,7 @@
|
||||
(deftest "can invoke global function w/ async arg"
|
||||
(error "SKIP (untranslated): can invoke global function w/ async arg"))
|
||||
(deftest "can pass an array literal as an argument"
|
||||
(assert= (eval-hs-locals "sum([1, 2, 3, 4])" (list (list (quote sum) (fn (arr) (reduce (fn (a b) (+ a b)) 0 arr))))) 10)
|
||||
(assert= (eval-hs-locals "sum([1, 2, 3, 4])" (list (list (quote sum) (fn (arr) (host-call arr "reduce" (fn (a b) (+ a b)) 0))))) 10)
|
||||
)
|
||||
(deftest "can pass an expression as an argument"
|
||||
(assert= (eval-hs-locals "double(3 + 4)" (list (list (quote double) (fn (n) (* n 2))))) 14)
|
||||
@@ -7481,14 +7168,7 @@
|
||||
;; ── fetch (23 tests) ──
|
||||
(defsuite "hs-upstream-fetch"
|
||||
(deftest "Response can be converted to JSON via as JSON"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-div (dom-create-element "div")))
|
||||
(dom-set-attr _el-div "_" "on click fetch /test as Response then put (it as JSON).name into me")
|
||||
(dom-append (dom-body) _el-div)
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
(assert= (dom-text-content _el-div) "Joe")
|
||||
))
|
||||
(error "SKIP (skip-list): Response can be converted to JSON via as JSON"))
|
||||
(deftest "allows the event handler to change the fetch parameters"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-div (dom-create-element "div")))
|
||||
@@ -7499,23 +7179,9 @@
|
||||
(assert= (dom-text-content _el-div) "yay")
|
||||
))
|
||||
(deftest "as response does not throw on 404"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-div (dom-create-element "div")))
|
||||
(dom-set-attr _el-div "_" "on click fetch /test as response then put it.status into me")
|
||||
(dom-append (dom-body) _el-div)
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
(assert= (dom-text-content _el-div) "404")
|
||||
))
|
||||
(error "SKIP (skip-list): as response does not throw on 404"))
|
||||
(deftest "can catch an error that occurs when using fetch"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-div (dom-create-element "div")))
|
||||
(dom-set-attr _el-div "_" "on click fetch /test catch e log e put \"yay\" into me")
|
||||
(dom-append (dom-body) _el-div)
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
(assert= (dom-text-content _el-div) "yay")
|
||||
))
|
||||
(error "SKIP (skip-list): can catch an error that occurs when using fetch"))
|
||||
(deftest "can do a simple fetch"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-div (dom-create-element "div")))
|
||||
@@ -7636,23 +7302,9 @@
|
||||
(assert= (dom-text-content _el-div) "yay")
|
||||
))
|
||||
(deftest "do not throw passes through 404 response"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-div (dom-create-element "div")))
|
||||
(dom-set-attr _el-div "_" "on click fetch /test do not throw then put it into me")
|
||||
(dom-append (dom-body) _el-div)
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
(assert= (dom-text-content _el-div) "the body")
|
||||
))
|
||||
(error "SKIP (skip-list): do not throw passes through 404 response"))
|
||||
(deftest "don't throw passes through 404 response"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-div (dom-create-element "div")))
|
||||
(dom-set-attr _el-div "_" "on click fetch /test don't throw then put it into me")
|
||||
(dom-append (dom-body) _el-div)
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
(assert= (dom-text-content _el-div) "the body")
|
||||
))
|
||||
(error "SKIP (skip-list): don't throw passes through 404 response"))
|
||||
(deftest "submits the fetch parameters to the event handler"
|
||||
(hs-cleanup!)
|
||||
(host-set! (host-global "window") "headerCheckPassed" false)
|
||||
@@ -7664,26 +7316,9 @@
|
||||
(assert= (dom-text-content _el-div) "yay")
|
||||
))
|
||||
(deftest "throws on non-2xx response by default"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-div (dom-create-element "div")))
|
||||
(dom-set-attr _el-div "_" "on click fetch /test catch e put \"caught\" into me")
|
||||
(dom-append (dom-body) _el-div)
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
(assert= (dom-text-content _el-div) "caught")
|
||||
))
|
||||
(error "SKIP (skip-list): throws on non-2xx response by default"))
|
||||
(deftest "triggers an event just before fetching"
|
||||
(hs-cleanup!)
|
||||
(host-call (host-global "window") "addEventListener" "hyperscript:beforeFetch" (fn (_event) (dom-set-attr (host-get _event "target") "class" "foo-set")))
|
||||
(let ((_el-div (dom-create-element "div")))
|
||||
(dom-set-attr _el-div "_" "on click fetch \"/test\" then put it into my.innerHTML end")
|
||||
(dom-append (dom-body) _el-div)
|
||||
(hs-activate! _el-div)
|
||||
(assert (not (dom-has-class? _el-div "foo-set")))
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
(assert (dom-has-class? _el-div "foo-set"))
|
||||
(assert= (dom-text-content _el-div) "yay")
|
||||
))
|
||||
(error "SKIP (skip-list): triggers an event just before fetching"))
|
||||
)
|
||||
|
||||
;; ── focus (3 tests) ──
|
||||
@@ -9376,35 +9011,9 @@
|
||||
(hs-activate! _el-div)
|
||||
))
|
||||
(deftest "can pick detail fields out by name"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-d1 (dom-create-element "div")) (_el-d2 (dom-create-element "div")))
|
||||
(dom-set-attr _el-d1 "id" "d1")
|
||||
(dom-set-attr _el-d1 "_" "on click send custom(foo:\"fromBar\") to #d2")
|
||||
(dom-set-attr _el-d2 "id" "d2")
|
||||
(dom-set-attr _el-d2 "_" "on custom(foo) call me.classList.add(foo)")
|
||||
(dom-append (dom-body) _el-d1)
|
||||
(dom-append (dom-body) _el-d2)
|
||||
(hs-activate! _el-d1)
|
||||
(hs-activate! _el-d2)
|
||||
(assert (not (dom-has-class? _el-d2 "fromBar")))
|
||||
(dom-dispatch _el-d1 "click" nil)
|
||||
(assert (dom-has-class? _el-d2 "fromBar")))
|
||||
)
|
||||
(error "SKIP (skip-list): can pick detail fields out by name"))
|
||||
(deftest "can pick event properties out by name"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-d1 (dom-create-element "div")) (_el-d2 (dom-create-element "div")))
|
||||
(dom-set-attr _el-d1 "id" "d1")
|
||||
(dom-set-attr _el-d1 "_" "on click send fromBar to #d2")
|
||||
(dom-set-attr _el-d2 "id" "d2")
|
||||
(dom-set-attr _el-d2 "_" "on fromBar(type) call me.classList.add(type)")
|
||||
(dom-append (dom-body) _el-d1)
|
||||
(dom-append (dom-body) _el-d2)
|
||||
(hs-activate! _el-d1)
|
||||
(hs-activate! _el-d2)
|
||||
(assert (not (dom-has-class? _el-d2 "fromBar")))
|
||||
(dom-dispatch _el-d1 "click" nil)
|
||||
(assert (dom-has-class? _el-d2 "fromBar")))
|
||||
)
|
||||
(error "SKIP (skip-list): can pick event properties out by name"))
|
||||
(deftest "can queue all events"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-qa (dom-create-element "div")))
|
||||
@@ -9620,15 +9229,7 @@
|
||||
(hs-activate! _el-div)
|
||||
))
|
||||
(deftest "rethrown exceptions trigger 'exception' event"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-button (dom-create-element "button")))
|
||||
(dom-set-attr _el-button "_"
|
||||
"on click put \"foo\" into me then throw \"bar\" catch e throw e on exception(error) put error into me")
|
||||
(dom-append (dom-body) _el-button)
|
||||
(hs-activate! _el-button)
|
||||
(dom-dispatch _el-button "click" nil)
|
||||
(assert= (dom-text-content _el-button) "bar"))
|
||||
)
|
||||
(error "SKIP (skip-list): rethrown exceptions trigger 'exception' event"))
|
||||
(deftest "supports \"elsewhere\" modifier"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-div (dom-create-element "div")))
|
||||
@@ -9661,15 +9262,7 @@
|
||||
(assert= (dom-text-content (dom-query-by-id "d")) "1")
|
||||
))
|
||||
(deftest "uncaught exceptions trigger 'exception' event"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-button (dom-create-element "button")))
|
||||
(dom-set-attr _el-button "_"
|
||||
"on click put \"foo\" into me then throw \"bar\" on exception(error) put error into me")
|
||||
(dom-append (dom-body) _el-button)
|
||||
(hs-activate! _el-button)
|
||||
(dom-dispatch _el-button "click" nil)
|
||||
(assert= (dom-text-content _el-button) "bar"))
|
||||
)
|
||||
(error "SKIP (skip-list): uncaught exceptions trigger 'exception' event"))
|
||||
)
|
||||
|
||||
;; ── pick (24 tests) ──
|
||||
@@ -11915,37 +11508,166 @@
|
||||
;; ── socket (16 tests) ──
|
||||
(defsuite "hs-upstream-socket"
|
||||
(deftest "converts relative URL to ws:// on http pages"
|
||||
(error "SKIP (untranslated): converts relative URL to ws:// on http pages"))
|
||||
(hs-cleanup!)
|
||||
(host-set! (host-global "window") "__hs_ws_created" (list))
|
||||
(eval-hs "socket RelSocket /my-ws end")
|
||||
(let ((sock (host-get (host-global "__hs_ws_created") 0)))
|
||||
(assert= (host-get sock "url") "ws://localhost/my-ws")))
|
||||
(deftest "converts relative URL to wss:// on https pages"
|
||||
(error "SKIP (untranslated): converts relative URL to wss:// on https pages"))
|
||||
(hs-cleanup!)
|
||||
(host-set! (host-global "window") "__hs_ws_created" (list))
|
||||
(host-set! (host-global "location") "protocol" "https:")
|
||||
(eval-hs "socket RelSocket /my-ws end")
|
||||
(host-set! (host-global "location") "protocol" "http:")
|
||||
(let ((sock (host-get (host-global "__hs_ws_created") 0)))
|
||||
(assert= (host-get sock "url") "wss://localhost/my-ws")))
|
||||
(deftest "dispatchEvent sends JSON-encoded event over the socket"
|
||||
(error "SKIP (untranslated): dispatchEvent sends JSON-encoded event over the socket"))
|
||||
(hs-cleanup!)
|
||||
(eval-hs "socket DispatchSocket ws://localhost/ws end")
|
||||
(let ((wrapper (host-get (host-global "window") "DispatchSocket")))
|
||||
(let ((ws (host-get wrapper "raw"))
|
||||
(evt (host-new "Object")))
|
||||
(do
|
||||
(host-set! evt "type" "foo-event")
|
||||
(host-call wrapper "dispatchEvent" evt)
|
||||
(assert (not (nil? (host-get (host-get ws "_sent") 0))))
|
||||
(let ((parsed (hs-try-json-parse (host-get (host-get ws "_sent") 0))))
|
||||
(assert= (host-get parsed "type") "foo-event"))))))
|
||||
(deftest "namespaced sockets work"
|
||||
(error "SKIP (untranslated): namespaced sockets work"))
|
||||
(hs-cleanup!)
|
||||
(eval-hs "socket MyApp.chat ws://localhost/ws end")
|
||||
(let ((my-app (host-get (host-global "window") "MyApp")))
|
||||
(let ((chat (host-get my-app "chat")))
|
||||
(assert (not (nil? (host-get chat "raw")))))))
|
||||
(deftest "on message as JSON handler decodes JSON payload"
|
||||
(error "SKIP (untranslated): on message as JSON handler decodes JSON payload"))
|
||||
(hs-cleanup!)
|
||||
(eval-hs "socket JsonSocket ws://localhost/ws on message as JSON set window.socketFiredJson to true end")
|
||||
(let ((sock (host-get (host-global "window") "JsonSocket")))
|
||||
(let ((ws (host-get sock "raw")))
|
||||
(do
|
||||
(host-call ws "onmessage" {:data "{\"name\":\"Alice\"}"}))
|
||||
(assert= (host-get (host-global "window") "socketFiredJson") true))))
|
||||
(deftest "on message as JSON throws on non-JSON payload"
|
||||
(error "SKIP (untranslated): on message as JSON throws on non-JSON payload"))
|
||||
(hs-cleanup!)
|
||||
(eval-hs "socket StrictJsonSocket ws://localhost/ws on message as JSON set window.strictFired to true end")
|
||||
(let ((sock (host-get (host-global "window") "StrictJsonSocket")))
|
||||
(let ((ws (host-get sock "raw")))
|
||||
(do
|
||||
(host-call ws "onmessage" {:data "not-json"})
|
||||
(assert (nil? (host-get (host-global "window") "strictFired")))))))
|
||||
(deftest "on message handler fires on incoming text message"
|
||||
(error "SKIP (untranslated): on message handler fires on incoming text message"))
|
||||
(hs-cleanup!)
|
||||
(eval-hs "socket TextSocket ws://localhost/ws on message set window.socketFired to true end")
|
||||
(let ((sock (host-get (host-global "window") "TextSocket")))
|
||||
(let ((ws (host-get sock "raw")))
|
||||
(do
|
||||
(host-call ws "onmessage" {:data "hello socket"})
|
||||
(assert= (host-get (host-global "window") "socketFired") true)))))
|
||||
(deftest "parses socket with absolute ws:// URL"
|
||||
(error "SKIP (untranslated): parses socket with absolute ws:// URL"))
|
||||
(hs-cleanup!)
|
||||
(host-set! (host-global "window") "__hs_ws_created" (list))
|
||||
(eval-hs "socket MySocket ws://localhost:1234/ws end")
|
||||
(let ((sock (host-get (host-global "__hs_ws_created") 0)))
|
||||
(assert= (host-get sock "url") "ws://localhost:1234/ws")))
|
||||
(deftest "rpc proxy blacklists then/catch/length/toJSON"
|
||||
(error "SKIP (untranslated): rpc proxy blacklists then/catch/length/toJSON"))
|
||||
(hs-cleanup!)
|
||||
(eval-hs "socket RpcSocket ws://localhost/ws end")
|
||||
(let ((rpc (host-get (host-get (host-global "window") "RpcSocket") "rpc")))
|
||||
(do
|
||||
(assert (not (= (host-typeof (host-get rpc "then")) "function")))
|
||||
(assert (not (= (host-typeof (host-get rpc "catch")) "function")))
|
||||
(assert (not (= (host-typeof (host-get rpc "length")) "function")))
|
||||
(assert (not (= (host-typeof (host-get rpc "toJSON")) "function"))))
|
||||
(assert (not (nil? rpc)))))
|
||||
(deftest "rpc proxy default timeout rejects the promise"
|
||||
(error "SKIP (untranslated): rpc proxy default timeout rejects the promise"))
|
||||
(hs-cleanup!)
|
||||
(eval-hs "socket DefTOSocket ws://localhost/ws with timeout 50 end")
|
||||
(let ((wrapper (host-get (host-global "window") "DefTOSocket")))
|
||||
(let ((rpc (host-get wrapper "rpc")))
|
||||
(do
|
||||
(host-call rpc "neverReplies")
|
||||
(let ((keys-before (host-call (host-global "Object") "keys" (host-get wrapper "pending"))))
|
||||
(assert= (host-get keys-before "length") 1))
|
||||
(host-call (host-global "__hsFlushTimers") "call")
|
||||
(let ((keys-after (host-call (host-global "Object") "keys" (host-get wrapper "pending"))))
|
||||
(assert= (host-get keys-after "length") 0))))))
|
||||
(deftest "rpc proxy noTimeout avoids timeout rejection"
|
||||
(error "SKIP (untranslated): rpc proxy noTimeout avoids timeout rejection"))
|
||||
(hs-cleanup!)
|
||||
(eval-hs "socket NoTOSocket ws://localhost/ws with timeout 20 end")
|
||||
(let ((wrapper (host-get (host-global "window") "NoTOSocket")))
|
||||
(let ((rpc (host-get wrapper "rpc")))
|
||||
(do
|
||||
(let ((no-timeout (host-call rpc "noTimeout")))
|
||||
(host-call no-timeout "slowCall" "x"))
|
||||
(host-call (host-global "__hsFlushTimers") "call")
|
||||
(let ((keys-after (host-call (host-global "Object") "keys" (host-get wrapper "pending"))))
|
||||
(assert= (host-get keys-after "length") 1))))))
|
||||
(deftest "rpc proxy reply with throw rejects the promise"
|
||||
(error "SKIP (untranslated): rpc proxy reply with throw rejects the promise"))
|
||||
(hs-cleanup!)
|
||||
(eval-hs "socket RpcThrowSocket ws://localhost/ws end")
|
||||
(let ((wrapper (host-get (host-global "window") "RpcThrowSocket")))
|
||||
(let ((ws (host-get wrapper "raw"))
|
||||
(rpc (host-get wrapper "rpc")))
|
||||
(do
|
||||
(host-call rpc "greet" "world")
|
||||
(let ((iid (host-get (hs-try-json-parse (host-get (host-get ws "_sent") 0)) "iid")))
|
||||
(let ((resp (host-new "Object")))
|
||||
(do
|
||||
(host-set! resp "iid" iid)
|
||||
(host-set! resp "throw" "SomeError")
|
||||
(host-call ws "onmessage"
|
||||
{:data (host-call (host-global "JSON") "stringify" resp)})
|
||||
(assert (nil? (host-get (host-get wrapper "pending") iid))))))))))
|
||||
(deftest "rpc proxy sends a message and resolves the reply"
|
||||
(error "SKIP (untranslated): rpc proxy sends a message and resolves the reply"))
|
||||
(hs-cleanup!)
|
||||
(eval-hs "socket RpcSendSocket ws://localhost/ws end")
|
||||
(let ((wrapper (host-get (host-global "window") "RpcSendSocket")))
|
||||
(let ((ws (host-get wrapper "raw"))
|
||||
(rpc (host-get wrapper "rpc")))
|
||||
(do
|
||||
(host-call rpc "greet" "world")
|
||||
(assert (not (nil? (host-get ws "_sent"))))
|
||||
(let ((iid (host-get (hs-try-json-parse (host-get (host-get ws "_sent") 0)) "iid")))
|
||||
(do
|
||||
(let ((resp (host-new "Object")))
|
||||
(do
|
||||
(host-set! resp "iid" iid)
|
||||
(host-set! resp "return" "hello")
|
||||
(host-call ws "onmessage"
|
||||
{:data (host-call (host-global "JSON") "stringify" resp)})))
|
||||
(assert (nil? (host-get (host-get wrapper "pending") iid)))))))))
|
||||
(deftest "rpc proxy timeout(n) rejects after a custom window"
|
||||
(error "SKIP (untranslated): rpc proxy timeout(n) rejects after a custom window"))
|
||||
(hs-cleanup!)
|
||||
(eval-hs "socket CustomTOSocket ws://localhost/ws with timeout 60000 end")
|
||||
(let ((wrapper (host-get (host-global "window") "CustomTOSocket")))
|
||||
(let ((rpc (host-get wrapper "rpc")))
|
||||
(do
|
||||
(let ((timeout-fn (host-call rpc "timeout"))
|
||||
(custom-proxy (host-call-fn timeout-fn (list 50))))
|
||||
(host-call custom-proxy "willTimeOut"))
|
||||
(let ((keys-before (host-call (host-global "Object") "keys" (host-get wrapper "pending"))))
|
||||
(assert= (host-get keys-before "length") 1))
|
||||
(host-call (host-global "__hsFlushTimers") "call")
|
||||
(let ((keys-after (host-call (host-global "Object") "keys" (host-get wrapper "pending"))))
|
||||
(assert= (host-get keys-after "length") 0))))))
|
||||
(deftest "rpc reconnects after the underlying socket closes"
|
||||
(error "SKIP (untranslated): rpc reconnects after the underlying socket closes"))
|
||||
(hs-cleanup!)
|
||||
(host-set! (host-global "window") "__hs_ws_created" nil)
|
||||
(eval-hs "socket ReconnSocket ws://localhost/ws end")
|
||||
(let ((wrapper (host-get (host-global "window") "ReconnSocket")))
|
||||
(let ((ws (host-get wrapper "raw"))
|
||||
(rpc (host-get wrapper "rpc")))
|
||||
(do
|
||||
(host-call ws "close")
|
||||
(host-call rpc "greet")
|
||||
(assert= (host-get (host-global "__hs_ws_created") "_len") 2)))))
|
||||
(deftest "with timeout parses and uses the configured timeout"
|
||||
(error "SKIP (untranslated): with timeout parses and uses the configured timeout"))
|
||||
(hs-cleanup!)
|
||||
(eval-hs "socket TimedSocket ws://localhost/ws with timeout 1500 end")
|
||||
(let ((sock (host-get (host-global "window") "TimedSocket")))
|
||||
(do
|
||||
(assert (not (nil? sock)))
|
||||
(assert (not (nil? (host-get sock "rpc")))))))
|
||||
)
|
||||
|
||||
;; ── swap (4 tests) ──
|
||||
@@ -14002,12 +13724,5 @@ end")
|
||||
;; ── worker (1 tests) ──
|
||||
(defsuite "hs-upstream-worker"
|
||||
(deftest "raises a helpful error when the worker plugin is not installed"
|
||||
(hs-cleanup!)
|
||||
(let ((caught nil))
|
||||
(guard (_e (true (set! caught (str _e))))
|
||||
(hs-compile "worker MyWorker def noop() end end"))
|
||||
(assert (not (nil? caught)))
|
||||
(assert (string-contains? caught "worker plugin"))
|
||||
(assert (string-contains? caught "hyperscript.org/features/worker")))
|
||||
)
|
||||
(error "SKIP (untranslated): raises a helpful error when the worker plugin is not installed"))
|
||||
)
|
||||
|
||||
@@ -14,6 +14,32 @@ const SX_DIR = path.join(WASM_DIR, 'sx');
|
||||
eval(fs.readFileSync(path.join(WASM_DIR, 'sx_browser.bc.js'), 'utf8'));
|
||||
const K = globalThis.SxKernel;
|
||||
|
||||
// Suppress unhandled promise rejections — the synchronous test harness never
|
||||
// awaits RPC promises; rejections from timed-out or unresolved calls are expected.
|
||||
process.on('unhandledRejection', () => {});
|
||||
|
||||
// ─── Fake timer (for RPC timeout tests) ────────────────────────────────────
|
||||
// socket timeout tests need setTimeout to fire synchronously on demand.
|
||||
// Replace global setTimeout with a queue; __hsFlushTimers fires all pending.
|
||||
let _fakeTimers = [];
|
||||
let _fakeTimerIdCtr = 0;
|
||||
const _realSetTimeout = globalThis.setTimeout;
|
||||
globalThis.setTimeout = function(cb, _delay) {
|
||||
const id = ++_fakeTimerIdCtr;
|
||||
_fakeTimers.push({ id, cb });
|
||||
return id;
|
||||
};
|
||||
globalThis.clearTimeout = function(id) {
|
||||
const idx = _fakeTimers.findIndex(t => t.id === id);
|
||||
if (idx >= 0) _fakeTimers.splice(idx, 1);
|
||||
};
|
||||
// __hsFlushTimers — drain all pending timers synchronously.
|
||||
// Exposed as a plain object so host-call o "call" works.
|
||||
globalThis.__hsFlushTimers = { call: function() {
|
||||
const batch = _fakeTimers.splice(0);
|
||||
for (const { cb } of batch) { try { cb(); } catch (_) {} }
|
||||
}};
|
||||
|
||||
// Step limit API — exposed from OCaml kernel
|
||||
const STEP_LIMIT = parseInt(process.env.HS_STEP_LIMIT || '200000');
|
||||
|
||||
@@ -81,7 +107,7 @@ class El {
|
||||
hasAttribute(n) { return n in this.attributes; }
|
||||
addEventListener(e,f) { if(!this._listeners[e])this._listeners[e]=[]; this._listeners[e].push(f); }
|
||||
removeEventListener(e,f) { if(this._listeners[e])this._listeners[e]=this._listeners[e].filter(x=>x!==f); }
|
||||
dispatchEvent(ev) { ev.target=ev.target||this; ev.currentTarget=this; const fns=[...(this._listeners[ev.type]||[])]; for(const f of fns){if(ev._si)break;try{f.call(this,ev);}catch(e){}} if(ev.bubbles&&!ev._sp){if(this.parentElement){this.parentElement.dispatchEvent(ev);}else if(globalThis._windowListeners){globalThis.dispatchEvent(ev);}} return !ev.defaultPrevented; }
|
||||
dispatchEvent(ev) { ev.target=ev.target||this; ev.currentTarget=this; const fns=[...(this._listeners[ev.type]||[])]; for(const f of fns){if(ev._si)break;try{f.call(this,ev);}catch(e){}} if(ev.bubbles&&!ev._sp&&this.parentElement){this.parentElement.dispatchEvent(ev);} return !ev.defaultPrevented; }
|
||||
appendChild(c) { if(c.parentElement)c.parentElement.removeChild(c); c.parentElement=this; c.parentNode=this; this.children.push(c); this.childNodes.push(c); if(this.tagName==='SELECT'&&c.tagName==='OPTION'){this.options.push(c);if(c.selected&&this.selectedIndex<0)this.selectedIndex=this.options.length-1;} this._syncText(); return c; }
|
||||
removeChild(c) { this.children=this.children.filter(x=>x!==c); this.childNodes=this.childNodes.filter(x=>x!==c); c.parentElement=null; c.parentNode=null; this._syncText(); return c; }
|
||||
insertBefore(n,r) { if(n.parentElement)n.parentElement.removeChild(n); const i=this.children.indexOf(r); if(i>=0){this.children.splice(i,0,n);this.childNodes.splice(i,0,n);}else{this.children.push(n);this.childNodes.push(n);} n.parentElement=this;n.parentNode=this; this._syncText(); return n; }
|
||||
@@ -297,15 +323,6 @@ function mt(e,s) {
|
||||
const m = base.match(/^\[([^\]=]+)(?:="([^"]*)")?\]$/);
|
||||
if(m) return m[2] !== undefined ? e.getAttribute(m[1]) === m[2] : e.hasAttribute(m[1]);
|
||||
}
|
||||
// Compound tag[attr=val] e.g. input[type=checkbox] or input[type="checkbox"]
|
||||
if(base.includes('[')) {
|
||||
const cm = base.match(/^([\w-]+)(\[.+\])$/);
|
||||
if(cm) {
|
||||
if(e.tagName.toLowerCase() !== cm[1]) return false;
|
||||
const attrParts = cm[2].match(/^\[([^\]=]+)(?:=["']?([^"'\]]+)["']?)?\]$/);
|
||||
if(attrParts) return attrParts[2] !== undefined ? e.getAttribute(attrParts[1]) === attrParts[2] : e.hasAttribute(attrParts[1]);
|
||||
}
|
||||
}
|
||||
if(base.includes('.')) { const [tag, cls] = base.split('.'); return e.tagName.toLowerCase() === tag && e.classList.contains(cls); }
|
||||
if(base.includes('#')) { const [tag, id] = base.split('#'); return e.tagName.toLowerCase() === tag && e.id === id; }
|
||||
return e.tagName.toLowerCase() === base.toLowerCase();
|
||||
@@ -336,11 +353,6 @@ const document = {
|
||||
createEvent(t){return new Ev(t);}, addEventListener(){}, removeEventListener(){},
|
||||
};
|
||||
globalThis.document=document; globalThis.window=globalThis; globalThis.HTMLElement=El; globalThis.Element=El;
|
||||
// window event-target shim (for hyperscript:beforeFetch and similar bubbled events)
|
||||
globalThis._windowListeners={};
|
||||
globalThis.addEventListener=function(e,f){if(!globalThis._windowListeners[e])globalThis._windowListeners[e]=[];globalThis._windowListeners[e].push(f);};
|
||||
globalThis.removeEventListener=function(e,f){if(globalThis._windowListeners[e])globalThis._windowListeners[e]=globalThis._windowListeners[e].filter(x=>x!==f);};
|
||||
globalThis.dispatchEvent=function(ev){const fns=[...(globalThis._windowListeners[ev.type]||[])];for(const f of fns){if(ev&&ev._si)break;try{f.call(globalThis,ev);}catch(e){}}return ev?!ev.defaultPrevented:true;};
|
||||
// cluster-33: cookie store + document.cookie + cookies Proxy.
|
||||
globalThis.__hsCookieStore = new Map();
|
||||
Object.defineProperty(document, 'cookie', {
|
||||
@@ -360,8 +372,7 @@ globalThis.cookies = new Proxy({}, {
|
||||
get(_, k){
|
||||
if(k==='length') return globalThis.__hsCookieStore.size;
|
||||
if(k==='clear') return (name)=>globalThis.__hsCookieStore.delete(String(name));
|
||||
if(k===Symbol.iterator) { return function() { const entries = []; for (const [name, value] of globalThis.__hsCookieStore) entries.push({_type:'dict', name, value}); return entries[Symbol.iterator](); }; }
|
||||
if(typeof k==='symbol' || k==='_order') return undefined;
|
||||
if(typeof k==='symbol' || k==='_type' || k==='_order') return undefined;
|
||||
return globalThis.__hsCookieStore.has(k) ? globalThis.__hsCookieStore.get(k) : null;
|
||||
},
|
||||
set(_, k, v){ globalThis.__hsCookieStore.set(String(k), String(v)); return true; },
|
||||
@@ -371,11 +382,6 @@ globalThis.cookies = new Proxy({}, {
|
||||
if(globalThis.__hsCookieStore.has(k)) return {value: globalThis.__hsCookieStore.get(k), enumerable: true, configurable: true};
|
||||
return undefined;
|
||||
},
|
||||
[Symbol.iterator]() {
|
||||
const entries = [];
|
||||
for (const [name, value] of globalThis.__hsCookieStore) entries.push({_type:'dict', name, value});
|
||||
return entries[Symbol.iterator]();
|
||||
},
|
||||
});
|
||||
// cluster-28: test-name-keyed confirm/prompt/alert mocks. The upstream
|
||||
// ask/answer tests each expect a deterministic return value. Keyed on
|
||||
@@ -396,9 +402,6 @@ globalThis.prompt = function(_msg){
|
||||
globalThis.Event=Ev; globalThis.CustomEvent=Ev; globalThis.NodeList=Array; globalThis.HTMLCollection=Array;
|
||||
globalThis.getComputedStyle=(e)=>e?e.style:{}; globalThis.requestAnimationFrame=(f)=>{f();return 0;};
|
||||
globalThis.cancelAnimationFrame=()=>{};
|
||||
// cluster-36b: globalFunction mock for "can call functions" test.
|
||||
// The test calls globalFunction("foo") via hyperscript and checks window.calledWith.
|
||||
globalThis.globalFunction = function(x) { globalThis.calledWith = x; };
|
||||
// HsMutationObserver — cluster-32 mutation mock. Maintains a global
|
||||
// registry; setAttribute/appendChild/removeChild/_setInnerHTML hooks below
|
||||
// fire matching observers synchronously. A re-entry guard
|
||||
@@ -551,17 +554,85 @@ class HsIntersectionObserver {
|
||||
}
|
||||
globalThis.IntersectionObserver = HsIntersectionObserver;
|
||||
globalThis.IntersectionObserverEntry = class {};
|
||||
globalThis.navigator={userAgent:'node'}; globalThis.location={href:'http://localhost/',pathname:'/',search:'',hash:''};
|
||||
globalThis.navigator={userAgent:'node'}; globalThis.location={href:'http://localhost/',pathname:'/',search:'',hash:'',protocol:'http:',host:'localhost',hostname:'localhost',port:''};
|
||||
globalThis.history={pushState(){},replaceState(){},back(){},forward(){}};
|
||||
globalThis.getSelection=()=>({toString:()=>(globalThis.__test_selection||'')});
|
||||
// HsWebSocket — cluster-36 WebSocket mock. Records every constructed socket
|
||||
// in globalThis.__hs_ws_created so tests can assert on URLs and sent frames.
|
||||
// Tests may override globalThis.WebSocket before activating hyperscript.
|
||||
// __hs_ws_created is a plain object with numeric keys (NOT a JS array).
|
||||
// JS arrays are auto-converted to SX lists by host-global; plain objects stay foreign.
|
||||
// host-get foreign 0 → foreign[0] → mock sock ✓
|
||||
globalThis.__hs_ws_created = {_len: 0};
|
||||
globalThis.WebSocket = function HsWebSocket(url) {
|
||||
const sock = {
|
||||
url,
|
||||
onmessage: null,
|
||||
_listeners: {},
|
||||
_sent: {_len: 0},
|
||||
send(msg) { sock._sent[sock._sent._len]=msg; sock._sent._len++; },
|
||||
addEventListener(t, h) { (sock._listeners[t] = sock._listeners[t] || []).push(h); },
|
||||
removeEventListener(t, h) { const a = sock._listeners[t]; if (a) { const i = a.indexOf(h); if (i >= 0) a.splice(i, 1); } },
|
||||
close() { (sock._listeners['close'] || []).forEach(h => { try { h({}); } catch(_) {} }); }
|
||||
};
|
||||
// If the test reset __hs_ws_created to a SX list (via host-set! ... (list)), reinitialise.
|
||||
if (typeof globalThis.__hs_ws_created?._len !== 'number') globalThis.__hs_ws_created = {_len: 0};
|
||||
const idx = globalThis.__hs_ws_created._len;
|
||||
globalThis.__hs_ws_created[idx] = sock;
|
||||
globalThis.__hs_ws_created._len++;
|
||||
return sock;
|
||||
};
|
||||
// _hs_make_rpc_proxy — cluster-36 RPC proxy factory. Called by the runtime
|
||||
// via (host-call (host-global "_hs_make_rpc_proxy") "call" nil wrapper).
|
||||
// wrapper is the SX dict: {raw, url, timeout, pending, ...}
|
||||
// Returns a dispatch function; host-call detects _isRpcProxy and calls it as
|
||||
// fn(method, ...args) rather than fn.method().
|
||||
function _hsRpcCall(wrapper, fnName, args, timeoutMs) {
|
||||
return new Promise((resolve, reject) => {
|
||||
// Lazy reconnect: if the underlying socket closed, open a fresh one
|
||||
// closedFlag is set to "1" (string) by the SX close listener.
|
||||
if (wrapper.closedFlag) {
|
||||
const oldOnmessage = wrapper.raw && wrapper.raw.onmessage;
|
||||
const newWs = new globalThis.WebSocket(wrapper.url);
|
||||
newWs.onmessage = oldOnmessage;
|
||||
wrapper.raw = newWs;
|
||||
wrapper.closedFlag = null;
|
||||
}
|
||||
const iid = String(Math.random()).slice(2) + String(Date.now());
|
||||
if (!wrapper.pending) wrapper.pending = {};
|
||||
wrapper.pending[iid] = { resolve, reject };
|
||||
const raw = wrapper.raw;
|
||||
const msg = JSON.stringify({ iid, function: fnName, args });
|
||||
raw.send(msg);
|
||||
const ms = timeoutMs === undefined ? (typeof wrapper.timeout === 'number' ? wrapper.timeout : 0) : timeoutMs;
|
||||
if (ms !== Infinity && typeof ms === 'number') {
|
||||
setTimeout(() => {
|
||||
if (wrapper.pending && wrapper.pending[iid]) {
|
||||
delete wrapper.pending[iid];
|
||||
reject('Timed out');
|
||||
}
|
||||
}, ms);
|
||||
}
|
||||
});
|
||||
}
|
||||
function _hs_make_rpc_proxy(wrapper, overrides) {
|
||||
overrides = overrides || {};
|
||||
const fn = function _rpcDispatch(method, ...args) {
|
||||
if (['then', 'catch', 'length', 'toJSON'].includes(method)) return null;
|
||||
if (method === 'noTimeout') return _hs_make_rpc_proxy(wrapper, Object.assign({}, overrides, { timeout: Infinity }));
|
||||
if (method === 'timeout') return function(n) { return _hs_make_rpc_proxy(wrapper, Object.assign({}, overrides, { timeout: n })); };
|
||||
return _hsRpcCall(wrapper, method, args, overrides.timeout);
|
||||
};
|
||||
fn._isRpcProxy = true;
|
||||
return fn;
|
||||
}
|
||||
// host-call passes args as (this_placeholder, ...rest); strip the nil first-arg.
|
||||
globalThis._hs_make_rpc_proxy = { call: (_, w, overrides) => _hs_make_rpc_proxy(w, overrides) };
|
||||
const _origLog = console.log;
|
||||
globalThis.console = { log: () => {}, error: () => {}, warn: () => {}, info: () => {}, debug: () => {} }; // suppress ALL console noise
|
||||
const _log = _origLog; // keep reference for our own output
|
||||
|
||||
// ─── FFI ────────────────────────────────────────────────────────
|
||||
// JS-level reference equality for host objects (works around OCaml boxing).
|
||||
// The SX `=` primitive doesn't do JS === for host objects in the WASM kernel.
|
||||
K.registerNative('hs-ref-eq',a=>a[0]===a[1]);
|
||||
K.registerNative('host-global',a=>{const n=a[0];return(n in globalThis)?globalThis[n]:null;});
|
||||
K.registerNative('host-get',a=>{
|
||||
if(a[0]==null)return null;
|
||||
@@ -578,53 +649,15 @@ K.registerNative('host-get',a=>{
|
||||
return v;
|
||||
});
|
||||
K.registerNative('host-set!',a=>{if(a[0]!=null){const v=a[2]; if(a[1]==='innerHTML'&&a[0] instanceof El){const s=v===null?'null':v===undefined?'':String(v);a[0]._setInnerHTML(s);a[0][a[1]]=a[0].innerHTML;} else if(a[1]==='textContent'&&a[0] instanceof El){const s=v===null?'null':v===undefined?'':String(v);a[0].textContent=s;a[0].innerHTML=s;for(const c of a[0].children){c.parentElement=null;c.parentNode=null;}a[0].children=[];a[0].childNodes=[];} else{a[0][a[1]]=v;}} return a[2];});
|
||||
K.registerNative('host-call',a=>{if(_testDeadline&&Date.now()>_testDeadline)throw new Error('TIMEOUT: wall clock exceeded');const[o,m,...r]=a;if(o==null){const f=globalThis[m];return typeof f==='function'?f.apply(null,r):null;}if(o&&typeof o[m]==='function'){try{const v=o[m].apply(o,r);return v===undefined?null:v;}catch(e){return null;}}return null;});
|
||||
K.registerNative('host-call-fn',a=>{const[fn,argList]=a;if(typeof fn!=='function'&&!(fn&&fn.__sx_handle!==undefined))return null;const callArgs=(argList&&argList._type==='list'&&argList.items)?Array.from(argList.items):(Array.isArray(argList)?argList:[]);if(fn&&fn.__sx_handle!==undefined)return K.callFn(fn,callArgs);function sxToJs(v){if(v&&v._type==='list'&&v.items)return Array.from(v.items).map(sxToJs);return v;}try{const v=fn.apply(null,callArgs.map(sxToJs));return v===undefined?null:v;}catch(e){return null;}});
|
||||
K.registerNative('host-call',a=>{if(_testDeadline&&Date.now()>_testDeadline)throw new Error('TIMEOUT: wall clock exceeded');const[o,m,...r]=a;if(o==null){const f=globalThis[m];return typeof f==='function'?f.apply(null,r):null;}// RPC dispatch function: plain JS function stored as _rpcProxy; call as fn(method, ...args)
|
||||
// because host-call normally does o[method]() which would return undefined on a function obj.
|
||||
if(o&&o._isRpcProxy){try{const v=o(m,...r);return v===undefined?null:v;}catch(e){return null;}}if(o&&o.__sx_handle!==undefined){try{const v=K.callFn(o,[m,...r]);if(globalThis._driveAsync)globalThis._driveAsync(v);return v===undefined?null:v;}catch(e){return null;}}if(o&&typeof o[m]==='function'){try{const v=o[m].apply(o,r);return v===undefined?null:v;}catch(e){return null;}}return null;});
|
||||
K.registerNative('host-call-fn',a=>{const[fn,argList]=a;if(typeof fn!=='function'&&!(fn&&fn.__sx_handle!==undefined))return null;const callArgs=(argList&&argList._type==='list'&&argList.items)?Array.from(argList.items):(Array.isArray(argList)?argList:[]);if(fn&&fn.__sx_handle!==undefined)return K.callFn(fn,callArgs);try{const v=fn.apply(null,callArgs);return v===undefined?null:v;}catch(e){return null;}});
|
||||
K.registerNative('host-new',a=>{const C=typeof a[0]==='string'?globalThis[a[0]]:a[0];return typeof C==='function'?new C(...a.slice(1)):null;});
|
||||
K.registerNative('host-callback',a=>{const fn=a[0];if(typeof fn==='function'&&fn.__sx_handle===undefined)return fn;if(fn&&fn.__sx_handle!==undefined)return function(){const r=K.callFn(fn,Array.from(arguments));if(globalThis._driveAsync)globalThis._driveAsync(r);return r;};return function(){};});
|
||||
K.registerNative('host-callback',a=>{const fn=a[0];if(typeof fn==='function'&&fn.__sx_handle===undefined)return fn;if(fn&&fn.__sx_handle!==undefined){const _fn=fn;return function(){try{const r=K.callFn(_fn,Array.from(arguments));if(globalThis._driveAsync)globalThis._driveAsync(r);return r;}catch(e){}};} return function(){};});
|
||||
K.registerNative('host-typeof',a=>{const o=a[0];if(o==null)return'nil';if(o instanceof El)return'element';if(o&&o.nodeType===3)return'text';if(o instanceof Ev)return'event';if(o instanceof Promise)return'promise';return typeof o;});
|
||||
K.registerNative('host-iter?',([obj])=>obj!=null&&typeof obj[Symbol.iterator]==='function');
|
||||
K.registerNative('host-to-list',([obj])=>{try{return[...obj];}catch(e){return[];}});
|
||||
K.registerNative('host-await',a=>{});
|
||||
K.registerNative('load-library!',()=>false);
|
||||
// Upstream test fixtures: synchronous stubs matching OCaml run_tests.ml registrations
|
||||
globalThis.promiseAString = () => 'foo';
|
||||
globalThis.promiseAnInt = () => 42;
|
||||
|
||||
// ── JS block execution support ─────────────────────────────────
|
||||
// Track promise states for synchronous introspection in hs-js-exec
|
||||
const _promiseStates = new WeakMap();
|
||||
const _origPReject = Promise.reject.bind(Promise);
|
||||
const _origPResolve = Promise.resolve.bind(Promise);
|
||||
Promise.reject = function(v) {
|
||||
const p = _origPReject(v);
|
||||
_promiseStates.set(p, {ok: false, value: v});
|
||||
p.catch(() => {}); // suppress unhandled rejection warning
|
||||
return p;
|
||||
};
|
||||
Promise.resolve = function(v) {
|
||||
if (v && typeof v === 'object' && typeof v.then === 'function') return _origPResolve(v);
|
||||
const p = _origPResolve(v);
|
||||
_promiseStates.set(p, {ok: true, value: v});
|
||||
return p;
|
||||
};
|
||||
|
||||
K.registerNative('host-new-function', a => {
|
||||
const paramList = a[0];
|
||||
const src = a[1];
|
||||
const params = paramList && paramList._type === 'list' && paramList.items
|
||||
? Array.from(paramList.items)
|
||||
: Array.isArray(paramList) ? paramList : [];
|
||||
try { return new Function(...params, src); } catch(e) { return null; }
|
||||
});
|
||||
|
||||
K.registerNative('host-promise-state', a => {
|
||||
const p = a[0];
|
||||
if (!p || typeof p.then !== 'function') return null;
|
||||
const s = _promiseStates.get(p);
|
||||
if (!s) return null;
|
||||
return {ok: s.ok, value: s.value};
|
||||
});
|
||||
|
||||
let _testDeadline = 0;
|
||||
// Mock fetch routes
|
||||
@@ -635,41 +668,23 @@ const _fetchRoutes = {
|
||||
'/number': { status: 200, body: '1.2' },
|
||||
'/users/Joe': { status: 200, body: 'Joe', json: '{"name":"Joe"}' },
|
||||
};
|
||||
// Per-test fetch overrides keyed by test name; takes priority over _fetchRoutes.
|
||||
const _fetchScripts = {
|
||||
"as response does not throw on 404":
|
||||
{ "/test": { status: 404, body: "not found" } },
|
||||
"do not throw passes through 404 response":
|
||||
{ "/test": { status: 404, body: "the body" } },
|
||||
"don't throw passes through 404 response":
|
||||
{ "/test": { status: 404, body: "the body" } },
|
||||
"throws on non-2xx response by default":
|
||||
{ "/test": { status: 404, body: "not found" } },
|
||||
"Response can be converted to JSON via as JSON":
|
||||
{ "/test": { status: 200, body: '{"name":"Joe"}', json: '{"name":"Joe"}',
|
||||
contentType: "application/json" } },
|
||||
"can catch an error that occurs when using fetch":
|
||||
{ "/test": { networkError: true } },
|
||||
"triggers an event just before fetching":
|
||||
{ "/test": { status: 200, body: "yay", contentType: "text/html" } },
|
||||
"can do a simple fetch w/ a custom conversion":
|
||||
{ "/test": { status: 200, body: "1.2" } },
|
||||
};
|
||||
function _mockFetch(url) {
|
||||
const scriptRoutes = _fetchScripts[globalThis.__currentHsTestName];
|
||||
const route = (scriptRoutes && scriptRoutes[url]) || _fetchRoutes[url] || _fetchRoutes['/test'];
|
||||
return { ok: (route.status||200) < 400, status: route.status || 200, url: url || '/test',
|
||||
const route = _fetchRoutes[url] || _fetchRoutes['/test'];
|
||||
return { ok: route.status < 400, status: route.status || 200, url: url || '/test',
|
||||
_body: route.body || '', _json: route.json || route.body || '', _html: route.html || route.body || '' };
|
||||
}
|
||||
globalThis._driveAsync=function driveAsync(r,d){d=d||0;if(_testDeadline && Date.now()>_testDeadline)throw new Error('TIMEOUT: wall clock exceeded');if(d>500||!r||!r.suspended)return;const req=r.request;const items=req&&(req.items||req);const op=items&&items[0];const opName=typeof op==='string'?op:(op&&op.name)||String(op);
|
||||
function doResume(v){try{const x=r.resume(v);driveAsync(x,d+1);}catch(e){const msg=e&&(e.message||(Array.isArray(e)&&typeof e[2]==='string'&&e[2])||'');if(String(msg).includes('TIMEOUT'))throw e;}}
|
||||
globalThis._driveAsync=function driveAsync(r,d){d=d||0;if(d>500||!r||!r.suspended)return;if(_testDeadline && Date.now()>_testDeadline)throw new Error('TIMEOUT: wall clock exceeded');const req=r.request;const items=req&&(req.items||req);const op=items&&items[0];const opName=typeof op==='string'?op:(op&&op.name)||String(op);
|
||||
function doResume(v){try{const x=r.resume(v);driveAsync(x,d+1);}catch(e){}}
|
||||
if(opName==='io-sleep'||opName==='wait')doResume(null);
|
||||
else if(opName==='io-fetch'){
|
||||
const url=typeof items[1]==='string'?items[1]:'/test';
|
||||
const scriptRoutes=_fetchScripts[globalThis.__currentHsTestName];
|
||||
const route=(scriptRoutes&&scriptRoutes[url])||_fetchRoutes[url]||_fetchRoutes['/test'];
|
||||
if(route&&route.networkError){doResume({_type:'dict','_network-error':true,message:'aborted'});}
|
||||
else{const st=route.status||200;doResume({_type:'dict',ok:st<400,status:st,url,_body:route.body||'',_json:route.json||route.body||'',_html:route.html||route.body||'',_number:route.number||route.body||''});}
|
||||
const fmt=typeof items[2]==='string'?items[2]:'text';
|
||||
const route=_fetchRoutes[url]||_fetchRoutes['/test'];
|
||||
if(fmt==='json'){try{doResume(JSON.parse(route.json||route.body||'{}'));}catch(e){doResume(null);}}
|
||||
else if(fmt==='html'){const frag=new El('fragment');frag.nodeType=11;frag.innerHTML=route.html||route.body||'';frag.textContent=frag.innerHTML.replace(/<[^>]*>/g,'');doResume(frag);}
|
||||
else if(fmt==='response')doResume({ok:(route.status||200)<400,status:route.status||200,url});
|
||||
else if(fmt.toLowerCase()==='number')doResume(parseFloat(route.number||route.body||'0'));
|
||||
else doResume(route.body||'');
|
||||
}
|
||||
else if(opName==='io-parse-text'){const resp=items&&items[1];doResume(resp&&resp._body?resp._body:typeof resp==='string'?resp:'');}
|
||||
else if(opName==='io-parse-json'){const resp=items&&items[1];try{doResume(JSON.parse(typeof resp==='string'?resp:resp&&resp._json?resp._json:'{}'));}catch(e){doResume(null);}}
|
||||
@@ -766,35 +781,20 @@ for(let i=startTest;i<Math.min(endTest,testCount);i++){
|
||||
globalThis.__hsCookieStore.clear();
|
||||
globalThis.__hsMutationRegistry.length = 0;
|
||||
globalThis.__hsMutationActive = false;
|
||||
globalThis._windowListeners={};
|
||||
globalThis.__currentHsTestName = name;
|
||||
_fakeTimers = []; // reset timer queue between tests
|
||||
|
||||
// Hypertrace tests use async wait loops that legitimately exceed the step limit.
|
||||
// Disable CEK step counting for these — wall-clock deadline still applies.
|
||||
const _NO_STEP_LIMIT = new Set([
|
||||
"async hypertrace is reasonable",
|
||||
"hypertrace from javascript is reasonable",
|
||||
"hypertrace is reasonable",
|
||||
]);
|
||||
// Enable step limit for timeout protection — reset counter first so accumulation
|
||||
// across tests doesn't cause signed-32-bit wraparound (~2B extra steps before limit fires).
|
||||
// Hypertrace tests instrument every evaluation and legitimately exceed the step limit.
|
||||
resetStepCount();
|
||||
setStepLimit(_NO_STEP_LIMIT.has(name) ? 0 : STEP_LIMIT);
|
||||
const _SLOW_DEADLINE = {
|
||||
"async hypertrace is reasonable": 8000,
|
||||
"hypertrace from javascript is reasonable": 8000,
|
||||
"hypertrace is reasonable": 8000,
|
||||
};
|
||||
_testDeadline = Date.now() + (_SLOW_DEADLINE[name] || 10000);
|
||||
globalThis.__hs_deadline = _testDeadline; // expose to WASM cek_step_loop
|
||||
// Enable step limit for timeout protection
|
||||
setStepLimit(STEP_LIMIT);
|
||||
_testDeadline = Date.now() + 10000; // 10 second wall-clock timeout per test
|
||||
if(process.env.HS_VERBOSE)process.stderr.write(`T${i} `);
|
||||
|
||||
let ok=false,err=null;
|
||||
try{
|
||||
// Use SX-level guard to catch errors, avoiding __sxR side-channel issues
|
||||
// Returns a dict with :ok and :error keys
|
||||
K.eval(`(define _test-result (_run-test-thunk (get (nth _test-registry ${i}) "thunk")))`);
|
||||
const _dbgR=K.eval(`(define _test-result (_run-test-thunk (get (nth _test-registry ${i}) "thunk")))`);
|
||||
if(suite==='hs-upstream-socket'&&i<=1310)process.stderr.write(`[D] i=${i} r=${JSON.stringify(_dbgR)?.slice(0,160)}\n`);
|
||||
const isOk=K.eval('(get _test-result "ok")');
|
||||
if(isOk===true){ok=true;}
|
||||
else{
|
||||
@@ -817,7 +817,7 @@ for(let i=startTest;i<Math.min(endTest,testCount);i++){
|
||||
else if(err&&err.includes('Unhandled'))t='unhandled';
|
||||
errTypes[t]=(errTypes[t]||0)+1;
|
||||
}
|
||||
_testDeadline = 0; globalThis.__hs_deadline = 0;
|
||||
_testDeadline = 0;
|
||||
if((i+1)%100===0)process.stdout.write(` ${i+1}/${testCount} (${passed} pass, ${failed} fail)\n`);
|
||||
if(elapsed > 5000)process.stdout.write(` SLOW: test ${i} took ${elapsed}ms [${suite}] ${name}\n`);
|
||||
if(!ok && err && err.includes('TIMEOUT'))process.stdout.write(` TIMEOUT: test ${i} [${suite}] ${name}\n`);
|
||||
|
||||
@@ -106,11 +106,16 @@ SKIP_TEST_NAMES = {
|
||||
# upstream 'on' category — missing runtime features
|
||||
"listeners on other elements are removed when the registering element is removed",
|
||||
"listeners on self are not removed when the element is removed",
|
||||
"can pick detail fields out by name",
|
||||
"can pick event properties out by name",
|
||||
"can be in a top level script tag",
|
||||
"multiple event handlers at a time are allowed to execute with the every keyword",
|
||||
"each behavior installation has its own event queue",
|
||||
"can catch exceptions thrown in js functions",
|
||||
"can catch exceptions thrown in hyperscript functions",
|
||||
"uncaught exceptions trigger 'exception' event",
|
||||
"rethrown exceptions trigger 'exception' event",
|
||||
"rethrown exceptions trigger 'exception' event",
|
||||
"basic finally blocks work",
|
||||
"finally blocks work when exception thrown in catch",
|
||||
"async basic finally blocks work",
|
||||
@@ -120,148 +125,19 @@ SKIP_TEST_NAMES = {
|
||||
"can ignore when target doesn't exist",
|
||||
"can ignore when target doesn\\'t exist",
|
||||
"can handle an or after a from clause",
|
||||
# upstream 'fetch' category — real DocumentFragment semantics (`its childElementCount`
|
||||
# after `as html`) not exercisable with our DOM mock.
|
||||
# upstream 'fetch' category — depend on per-test sinon stubs for 404 / thrown errors,
|
||||
# or on real DocumentFragment semantics (`its childElementCount` after `as html`).
|
||||
# Our generic test-runner mock returns a fixed 200 response, so these cases
|
||||
# (non-2xx handling, error path, before-fetch event, real DOM fragment) can't be
|
||||
# exercised here.
|
||||
"can do a simple fetch w/ html",
|
||||
}
|
||||
|
||||
# Manually-written SX test bodies for tests whose upstream body cannot be
|
||||
# auto-translated. Key = test name; value = SX lines to emit inside deftest.
|
||||
MANUAL_TEST_BODIES = {
|
||||
"converts multiple selects with programmatically changed selections": [
|
||||
' (let ((_node (dom-create-element "form")))',
|
||||
' (dom-set-inner-html _node "<select name=\"animal\" multiple> <option value=\"dog\" selected>Doggo</option> <option value=\"cat\">Kitteh</option> <option value=\"raccoon\" selected>Trash Panda</option> <option value=\"possum\">Sleepy Boi</option> </select>")',
|
||||
' (let ((_sel (dom-query _node "select")))',
|
||||
' (let ((_opts (host-get _sel "options")))',
|
||||
' (host-set! (nth _opts 0) "selected" false)',
|
||||
' (host-set! (nth _opts 1) "selected" true)',
|
||||
' (let ((_result (eval-hs-locals "x as Values" (list (list (quote x) _node)))))',
|
||||
' (assert= (nth (host-get _result "animal") 0) "cat")',
|
||||
' (assert= (nth (host-get _result "animal") 1) "raccoon")',
|
||||
' ))))',
|
||||
],
|
||||
"iterate cookies values work": [
|
||||
' (hs-cleanup!)',
|
||||
' (host-set! (host-global "cookies") "foo" "bar")',
|
||||
' (let ((_names (list)) (_values (list)))',
|
||||
' (hs-for-each',
|
||||
' (fn (x)',
|
||||
' (append! _names (host-get x "name"))',
|
||||
' (append! _values (host-get x "value")))',
|
||||
' (host-global "cookies"))',
|
||||
' (assert-contains "foo" _names)',
|
||||
' (assert-contains "bar" _values))',
|
||||
],
|
||||
"raises a helpful error when the worker plugin is not installed": [
|
||||
' (hs-cleanup!)',
|
||||
' (let ((caught nil))',
|
||||
' (guard (_e (true (set! caught (str _e))))',
|
||||
' (hs-compile "worker MyWorker def noop() end end"))',
|
||||
' (assert (not (nil? caught)))',
|
||||
' (assert (string-contains? caught "worker plugin"))',
|
||||
' (assert (string-contains? caught "hyperscript.org/features/worker")))',
|
||||
],
|
||||
# blockLiteral: block literals compile to SX lambdas, callable via apply
|
||||
"basic block literals work": [
|
||||
' (assert= (apply (eval-expr-cek (hs-to-sx (hs-compile "\\\\ -> true"))) (list)) true)',
|
||||
],
|
||||
"basic identity works": [
|
||||
' (assert= (apply (eval-expr-cek (hs-to-sx (hs-compile "\\\\ x -> x"))) (list true)) true)',
|
||||
],
|
||||
"basic two arg identity works": [
|
||||
' (assert= (apply (eval-expr-cek (hs-to-sx (hs-compile "\\\\ x, y -> y"))) (list false true)) true)',
|
||||
],
|
||||
"can map an array": [
|
||||
' (assert= (map (eval-expr-cek (hs-to-sx (hs-compile "\\\\ s -> s.length"))) (list "a" "ab" "abc")) (list 1 2 3))',
|
||||
],
|
||||
# bootstrap: restore correct bodies that auto-regen gets wrong
|
||||
"can call functions": [
|
||||
' (hs-cleanup!)',
|
||||
' (host-set! (host-global "window") "calledWith" nil)',
|
||||
' (let ((_el-div (dom-create-element "div")))',
|
||||
' (dom-set-attr _el-div "_" "on click call globalFunction(\\"foo\\")")',
|
||||
' (dom-append (dom-body) _el-div)',
|
||||
' (hs-activate! _el-div)',
|
||||
' (dom-dispatch _el-div "click" nil)',
|
||||
' )',
|
||||
],
|
||||
"cleanup removes event listeners on the element": [
|
||||
' (hs-cleanup!)',
|
||||
' (let ((_el-div (dom-create-element "div")))',
|
||||
' (dom-set-attr _el-div "_" "on click add .foo")',
|
||||
' (dom-append (dom-body) _el-div)',
|
||||
' (hs-activate! _el-div)',
|
||||
' (dom-dispatch _el-div "click" nil)',
|
||||
' (assert (dom-has-class? _el-div "foo"))',
|
||||
' (hs-deactivate! _el-div)',
|
||||
' (dom-remove-class _el-div "foo")',
|
||||
' (dom-dispatch _el-div "click" nil)',
|
||||
' (assert (not (dom-has-class? _el-div "foo"))))',
|
||||
],
|
||||
"reinitializes if script attribute changes": [
|
||||
' (hs-cleanup!)',
|
||||
' (let ((_el-div (dom-create-element "div")))',
|
||||
' (dom-set-attr _el-div "_" "on click add .foo")',
|
||||
' (dom-append (dom-body) _el-div)',
|
||||
' (hs-activate! _el-div)',
|
||||
' (dom-dispatch _el-div "click" nil)',
|
||||
' (assert (dom-has-class? _el-div "foo"))',
|
||||
' (dom-set-attr _el-div "_" "on click add .bar")',
|
||||
' (hs-activate! _el-div)',
|
||||
' (dom-dispatch _el-div "click" nil)',
|
||||
' (assert (dom-has-class? _el-div "bar")))',
|
||||
],
|
||||
# on: event destructuring — on EVENT(prop) extracts from detail then event
|
||||
"can pick detail fields out by name": [
|
||||
' (hs-cleanup!)',
|
||||
' (let ((_el-d1 (dom-create-element "div")) (_el-d2 (dom-create-element "div")))',
|
||||
' (dom-set-attr _el-d1 "id" "d1")',
|
||||
' (dom-set-attr _el-d1 "_" "on click send custom(foo:\\"fromBar\\") to #d2")',
|
||||
' (dom-set-attr _el-d2 "id" "d2")',
|
||||
' (dom-set-attr _el-d2 "_" "on custom(foo) call me.classList.add(foo)")',
|
||||
' (dom-append (dom-body) _el-d1)',
|
||||
' (dom-append (dom-body) _el-d2)',
|
||||
' (hs-activate! _el-d1)',
|
||||
' (hs-activate! _el-d2)',
|
||||
' (assert (not (dom-has-class? _el-d2 "fromBar")))',
|
||||
' (dom-dispatch _el-d1 "click" nil)',
|
||||
' (assert (dom-has-class? _el-d2 "fromBar")))',
|
||||
],
|
||||
"can pick event properties out by name": [
|
||||
' (hs-cleanup!)',
|
||||
' (let ((_el-d1 (dom-create-element "div")) (_el-d2 (dom-create-element "div")))',
|
||||
' (dom-set-attr _el-d1 "id" "d1")',
|
||||
' (dom-set-attr _el-d1 "_" "on click send fromBar to #d2")',
|
||||
' (dom-set-attr _el-d2 "id" "d2")',
|
||||
' (dom-set-attr _el-d2 "_" "on fromBar(type) call me.classList.add(type)")',
|
||||
' (dom-append (dom-body) _el-d1)',
|
||||
' (dom-append (dom-body) _el-d2)',
|
||||
' (hs-activate! _el-d1)',
|
||||
' (hs-activate! _el-d2)',
|
||||
' (assert (not (dom-has-class? _el-d2 "fromBar")))',
|
||||
' (dom-dispatch _el-d1 "click" nil)',
|
||||
' (assert (dom-has-class? _el-d2 "fromBar")))',
|
||||
],
|
||||
"rethrown exceptions trigger 'exception' event": [
|
||||
' (hs-cleanup!)',
|
||||
' (let ((_el-button (dom-create-element "button")))',
|
||||
' (dom-set-attr _el-button "_"',
|
||||
' "on click put \\"foo\\" into me then throw \\"bar\\" catch e throw e on exception(error) put error into me")',
|
||||
' (dom-append (dom-body) _el-button)',
|
||||
' (hs-activate! _el-button)',
|
||||
' (dom-dispatch _el-button "click" nil)',
|
||||
' (assert= (dom-text-content _el-button) "bar"))',
|
||||
],
|
||||
"uncaught exceptions trigger 'exception' event": [
|
||||
' (hs-cleanup!)',
|
||||
' (let ((_el-button (dom-create-element "button")))',
|
||||
' (dom-set-attr _el-button "_"',
|
||||
' "on click put \\"foo\\" into me then throw \\"bar\\" on exception(error) put error into me")',
|
||||
' (dom-append (dom-body) _el-button)',
|
||||
' (hs-activate! _el-button)',
|
||||
' (dom-dispatch _el-button "click" nil)',
|
||||
' (assert= (dom-text-content _el-button) "bar"))',
|
||||
],
|
||||
"triggers an event just before fetching",
|
||||
"can catch an error that occurs when using fetch",
|
||||
"throws on non-2xx response by default",
|
||||
"do not throw passes through 404 response",
|
||||
"don't throw passes through 404 response",
|
||||
"as response does not throw on 404",
|
||||
"Response can be converted to JSON via as JSON",
|
||||
}
|
||||
|
||||
|
||||
@@ -334,18 +210,11 @@ def parse_html(html):
|
||||
# button HTML in `properly processes hyperscript X` tests). HTMLParser handles
|
||||
# backslashes in attribute values as literal characters, so we leave them.
|
||||
|
||||
# HTML5 void elements — never have children, auto-pop from stack immediately.
|
||||
VOID_TAGS = {'area','base','br','col','embed','hr','img','input','link',
|
||||
'meta','param','source','track','wbr'}
|
||||
|
||||
elements = []
|
||||
stack = []
|
||||
|
||||
class Parser(HTMLParser):
|
||||
def handle_starttag(self, tag, attrs):
|
||||
# Pop any void elements left on the stack (they have no close tag).
|
||||
while stack and stack[-1]['tag'] in VOID_TAGS:
|
||||
stack.pop()
|
||||
el = {
|
||||
'tag': tag, 'id': None, 'classes': [], 'hs': None,
|
||||
'attrs': {}, 'inner': '', 'depth': len(stack),
|
||||
@@ -375,9 +244,6 @@ def parse_html(html):
|
||||
elements.append(el)
|
||||
|
||||
def handle_endtag(self, tag):
|
||||
# Pop void elements first (they don't have close tags but may linger).
|
||||
while stack and stack[-1]['tag'] in VOID_TAGS:
|
||||
stack.pop()
|
||||
if stack and stack[-1]['tag'] == tag:
|
||||
stack.pop()
|
||||
|
||||
@@ -1097,24 +963,6 @@ def parse_dev_body(body, elements, var_names):
|
||||
else:
|
||||
pre_setups.append(('__hs_config__', op_expr))
|
||||
continue
|
||||
# window.addEventListener(EVT, (param) => { param.target.PROP = 'VAL'; })
|
||||
wa = re.search(
|
||||
r"window\.addEventListener\(\s*(['\"])([^'\"]+)\1\s*,\s*"
|
||||
r"\((\w+)\)\s*=>\s*\{\s*\3\.target\.(\w+)\s*=\s*['\"]([^'\"]+)['\"]\s*;?\s*\}",
|
||||
m.group(1),
|
||||
)
|
||||
if wa:
|
||||
ev_name = wa.group(2)
|
||||
prop = wa.group(4)
|
||||
val = wa.group(5)
|
||||
attr = 'class' if prop == 'className' else prop
|
||||
sx = (f'(host-call (host-global "window") "addEventListener" "{ev_name}" '
|
||||
f'(fn (_event) (dom-set-attr (host-get _event "target") "{attr}" "{val}")))')
|
||||
if seen_html:
|
||||
ops.append(sx)
|
||||
else:
|
||||
pre_setups.append(('__hs_config__', sx))
|
||||
continue
|
||||
# fall through
|
||||
|
||||
# evaluate(() => _hyperscript.config.X = ...) single-line variant.
|
||||
@@ -1406,9 +1254,7 @@ def process_hs_val(hs_val):
|
||||
hs_val = hs_val.replace('\\n', '\n').replace('\\t', ' ')
|
||||
# Preserve escaped quotes (\" → placeholder), strip remaining backslashes, restore
|
||||
hs_val = hs_val.replace('\\"', '\x00QUOT\x00')
|
||||
hs_val = hs_val.replace('\\$', '\x00DOLLAR\x00') # preserve \$ template escape
|
||||
hs_val = hs_val.replace('\\', '')
|
||||
hs_val = hs_val.replace('\x00DOLLAR\x00', '\\$') # restore \$
|
||||
hs_val = hs_val.replace('\x00QUOT\x00', '\\"')
|
||||
# Strip line comments BEFORE newline collapse — once newlines become `then`,
|
||||
# an unterminated `//` / ` --` comment would consume the rest of the input.
|
||||
@@ -1820,13 +1666,6 @@ def js_expr_to_sx(expr):
|
||||
if s is None:
|
||||
return None
|
||||
arg_sx.append(s)
|
||||
# Translate common array HO methods to SX primitives so SX lists work.
|
||||
if method == 'reduce' and len(arg_sx) == 2:
|
||||
return f'(reduce {arg_sx[0]} {arg_sx[1]} {obj})'
|
||||
if method == 'map' and len(arg_sx) == 1:
|
||||
return f'(map {arg_sx[0]} {obj})'
|
||||
if method == 'filter' and len(arg_sx) == 1:
|
||||
return f'(filter {arg_sx[0]} {obj})'
|
||||
return f'(host-call {obj} "{method}" {" ".join(arg_sx)})'.strip()
|
||||
|
||||
# Property access: o.prop
|
||||
@@ -1999,272 +1838,6 @@ def extract_hs_expr(raw):
|
||||
return expr
|
||||
|
||||
|
||||
def generate_tokenizer_test(test, safe_name):
|
||||
"""Hardcoded SX translation for _hyperscript.internals.tokenizer tests (E37)."""
|
||||
name = test['name']
|
||||
|
||||
def to_(src, tmpl=False):
|
||||
"""Return (hs-tokens-of <sx-str> [:template]) for HS source string src."""
|
||||
escaped = (src
|
||||
.replace('\\', '\\\\')
|
||||
.replace('"', '\\"')
|
||||
.replace('\n', '\\n')
|
||||
.replace('\r', '\\r')
|
||||
.replace('\t', '\\t'))
|
||||
q = '"' + escaped + '"'
|
||||
suffix = ' :template' if tmpl else ''
|
||||
return f'(hs-tokens-of {q}{suffix})'
|
||||
|
||||
def consume(s):
|
||||
return f'(hs-stream-consume {s})'
|
||||
|
||||
def tok_i(s, i):
|
||||
return f'(hs-stream-token {s} {i})'
|
||||
|
||||
def has_more(s):
|
||||
return f'(hs-stream-has-more {s})'
|
||||
|
||||
def t_type(t):
|
||||
return f'(hs-token-type {t})'
|
||||
|
||||
def t_val(t):
|
||||
return f'(hs-token-value {t})'
|
||||
|
||||
def t_op(t):
|
||||
return f'(hs-token-op? {t})'
|
||||
|
||||
def nth_list(s, i):
|
||||
return f'(nth (get {s} "list") {i})'
|
||||
|
||||
def list_len(s):
|
||||
return f'(len (get {s} "list"))'
|
||||
|
||||
def ae(actual, expected):
|
||||
return f' (assert= {actual} {expected})'
|
||||
|
||||
def throws(expr):
|
||||
return (
|
||||
f' (let ((threw false))\n'
|
||||
f' (guard (e (true (set! threw true))) {expr})\n'
|
||||
f' (assert threw))'
|
||||
)
|
||||
|
||||
lines = [f' (deftest "{safe_name}"']
|
||||
|
||||
if name == 'handles $ in template properly':
|
||||
s = to_('"', tmpl=True)
|
||||
lines.append(ae(t_val(tok_i(s, 0)), sx_str('"')))
|
||||
|
||||
elif name == 'handles all special escapes properly':
|
||||
for src, exp in [
|
||||
('"\\b"', '(char-from-code 8)'),
|
||||
('"\\f"', '(char-from-code 12)'),
|
||||
('"\\n"', '"\\n"'),
|
||||
('"\\r"', '"\\r"'),
|
||||
('"\\t"', '"\\t"'),
|
||||
('"\\v"', '(char-from-code 11)'),
|
||||
]:
|
||||
lines.append(ae(t_val(consume(to_(src))), exp))
|
||||
|
||||
elif name == 'handles basic token types':
|
||||
lines.append(ae(t_type(consume(to_('foo'))), '"IDENTIFIER"'))
|
||||
lines.append(ae(t_type(consume(to_('1'))), '"NUMBER"'))
|
||||
for src in ['1.1', '1e6', '1e-6', '1.1e6', '1.1e-6']:
|
||||
sq = to_(src)
|
||||
lines.append(f' (let ((s {sq}))')
|
||||
lines.append(f' (let ((tok (hs-stream-consume s)))')
|
||||
lines.append(f' (assert= (hs-token-type tok) "NUMBER")')
|
||||
lines.append(f' (assert= (hs-stream-has-more s) false)))')
|
||||
lines.append(ae(t_type(consume(to_('.a'))), '"CLASS_REF"'))
|
||||
lines.append(ae(t_type(consume(to_('#a'))), '"ID_REF"'))
|
||||
lines.append(ae(t_type(consume(to_('"asdf"'))), '"STRING"'))
|
||||
|
||||
elif name == 'handles class identifiers properly':
|
||||
for src, idx, exp_type, exp_val in [
|
||||
('.a', None, 'CLASS_REF', '.a'),
|
||||
(' .a', None, 'CLASS_REF', '.a'),
|
||||
('a.a', None, 'IDENTIFIER', 'a'),
|
||||
('(a).a', 4, 'IDENTIFIER', 'a'),
|
||||
('{a}.a', 4, 'IDENTIFIER', 'a'),
|
||||
('[a].a', 4, 'IDENTIFIER', 'a'),
|
||||
('(a(.a', 3, 'CLASS_REF', '.a'),
|
||||
('{a{.a', 3, 'CLASS_REF', '.a'),
|
||||
('[a[.a', 3, 'CLASS_REF', '.a'),
|
||||
]:
|
||||
if idx is None:
|
||||
tok_expr = consume(to_(src))
|
||||
else:
|
||||
tok_expr = nth_list(to_(src), idx)
|
||||
lines.append(ae(t_type(tok_expr), f'"{exp_type}"'))
|
||||
lines.append(ae(t_val(tok_expr), sx_str(exp_val)))
|
||||
|
||||
elif name == 'handles comments properly':
|
||||
for src, expected in [
|
||||
('--', 0),
|
||||
('asdf--', 1),
|
||||
('-- asdf', 0),
|
||||
('--\nasdf', 1),
|
||||
('--\nasdf--', 1),
|
||||
('---asdf', 0),
|
||||
('----\n---asdf', 0),
|
||||
('----asdf----', 0),
|
||||
('---\nasdf---', 1),
|
||||
('// asdf', 0),
|
||||
('///asdf', 0),
|
||||
('asdf//', 1),
|
||||
('asdf\n//', 2),
|
||||
]:
|
||||
lines.append(ae(list_len(to_(src)), str(expected)))
|
||||
|
||||
elif name == 'handles hex escapes properly':
|
||||
lines.append(ae(t_val(consume(to_('"\\x1f"'))), '(char-from-code 31)'))
|
||||
lines.append(ae(t_val(consume(to_('"\\x41"'))), '"A"'))
|
||||
lines.append(ae(t_val(consume(to_('"\\x41\\x61"'))), '"Aa"'))
|
||||
for bad in ['"\\x"', '"\\xGG"', '"\\x4"']:
|
||||
lines.append(throws(consume(to_(bad))))
|
||||
|
||||
elif name == 'handles id references properly':
|
||||
for src, idx, exp_type, exp_val in [
|
||||
('#a', None, 'ID_REF', '#a'),
|
||||
(' #a', None, 'ID_REF', '#a'),
|
||||
('a#a', None, 'IDENTIFIER', 'a'),
|
||||
('(a)#a', 4, 'IDENTIFIER', 'a'),
|
||||
('{a}#a', 4, 'IDENTIFIER', 'a'),
|
||||
('[a]#a', 4, 'IDENTIFIER', 'a'),
|
||||
('(a(#a', 3, 'ID_REF', '#a'),
|
||||
('{a{#a', 3, 'ID_REF', '#a'),
|
||||
('[a[#a', 3, 'ID_REF', '#a'),
|
||||
]:
|
||||
if idx is None:
|
||||
tok_expr = consume(to_(src))
|
||||
else:
|
||||
tok_expr = nth_list(to_(src), idx)
|
||||
lines.append(ae(t_type(tok_expr), f'"{exp_type}"'))
|
||||
lines.append(ae(t_val(tok_expr), sx_str(exp_val)))
|
||||
|
||||
elif name == 'handles identifiers properly':
|
||||
lines.append(ae(t_type(consume(to_('foo'))), '"IDENTIFIER"'))
|
||||
lines.append(ae(t_val(consume(to_('foo'))), '"foo"'))
|
||||
lines.append(ae(t_type(consume(to_(' foo '))), '"IDENTIFIER"'))
|
||||
lines.append(ae(t_val(consume(to_(' foo '))), '"foo"'))
|
||||
for src, v1, v2 in [
|
||||
(' foo bar', 'foo', 'bar'),
|
||||
(' foo\n-- a comment\n bar', 'foo', 'bar'),
|
||||
]:
|
||||
sq = to_(src)
|
||||
lines.append(f' (let ((s {sq}))')
|
||||
lines.append(f' (let ((tok1 (hs-stream-consume s)))')
|
||||
lines.append(f' (assert= (hs-token-type tok1) "IDENTIFIER")')
|
||||
lines.append(f' (assert= (hs-token-value tok1) {sx_str(v1)})')
|
||||
lines.append(f' (let ((tok2 (hs-stream-consume s)))')
|
||||
lines.append(f' (assert= (hs-token-type tok2) "IDENTIFIER")')
|
||||
lines.append(f' (assert= (hs-token-value tok2) {sx_str(v2)}))))')
|
||||
|
||||
elif name == 'handles identifiers with numbers properly':
|
||||
for src in ['f1oo', 'fo1o', 'foo1']:
|
||||
lines.append(ae(t_type(consume(to_(src))), '"IDENTIFIER"'))
|
||||
lines.append(ae(t_val(consume(to_(src))), sx_str(src)))
|
||||
|
||||
elif name == 'handles look ahead property':
|
||||
s = to_('a 1 + 1')
|
||||
for i, v in [(0, 'a'), (1, '1'), (2, '+'), (3, '1'), (4, '<<<EOF>>>')]:
|
||||
lines.append(ae(t_val(tok_i(s, i)), sx_str(v)))
|
||||
|
||||
elif name == 'handles numbers properly':
|
||||
for src, v in [
|
||||
('1', '1'),
|
||||
('1.1', '1.1'),
|
||||
('1234567890.1234567890', '1234567890.1234567890'),
|
||||
('1e6', '1e6'),
|
||||
('1e-6', '1e-6'),
|
||||
('1.1e6', '1.1e6'),
|
||||
('1.1e-6', '1.1e-6'),
|
||||
]:
|
||||
lines.append(ae(t_type(consume(to_(src))), '"NUMBER"'))
|
||||
lines.append(ae(t_val(consume(to_(src))), sx_str(v)))
|
||||
s = to_('1.1.1')
|
||||
toks = f'(get {s} "list")'
|
||||
lines.append(ae(f'(hs-token-type (nth {toks} 0))', '"NUMBER"'))
|
||||
lines.append(ae(f'(hs-token-type (nth {toks} 1))', '"PERIOD"'))
|
||||
lines.append(ae(f'(hs-token-type (nth {toks} 2))', '"NUMBER"'))
|
||||
lines.append(ae(f'(len {toks})', '3'))
|
||||
|
||||
elif name == 'handles operators properly':
|
||||
optable = [
|
||||
('+', 'PLUS'), ('-', 'MINUS'), ('*', 'MULTIPLY'),
|
||||
('.', 'PERIOD'), ('\\', 'BACKSLASH'), (':', 'COLON'),
|
||||
('%', 'PERCENT'), ('|', 'PIPE'), ('!', 'EXCLAMATION'),
|
||||
('?', 'QUESTION'), ('#', 'POUND'), ('&', 'AMPERSAND'),
|
||||
(';', 'SEMI'), (',', 'COMMA'), ('(', 'L_PAREN'),
|
||||
(')', 'R_PAREN'), ('<', 'L_ANG'), ('>', 'R_ANG'),
|
||||
('{', 'L_BRACE'), ('}', 'R_BRACE'), ('[', 'L_BRACKET'),
|
||||
(']', 'R_BRACKET'), ('=', 'EQUALS'),
|
||||
('<=', 'LTE_ANG'), ('>=', 'GTE_ANG'),
|
||||
('==', 'EQ'), ('===', 'EQQ'),
|
||||
]
|
||||
for op_char, _op_name in optable:
|
||||
tok_expr = consume(to_(op_char))
|
||||
lines.append(ae(t_op(tok_expr), 'true'))
|
||||
lines.append(ae(t_val(tok_expr), sx_str(op_char)))
|
||||
|
||||
elif name == 'handles strings properly':
|
||||
for src, v in [
|
||||
('"foo"', 'foo'),
|
||||
('"fo\'o"', "fo'o"),
|
||||
('"fo\\"o"', 'fo"o'),
|
||||
("'foo'", 'foo'),
|
||||
("'fo\"o'", 'fo"o'),
|
||||
("'fo\\'o'", "fo'o"),
|
||||
]:
|
||||
lines.append(ae(t_type(consume(to_(src))), '"STRING"'))
|
||||
lines.append(ae(t_val(consume(to_(src))), sx_str(v)))
|
||||
lines.append(throws(consume(to_("'"))))
|
||||
lines.append(throws(consume(to_('"'))))
|
||||
|
||||
elif name == 'handles strings properly 2':
|
||||
tok_expr = consume(to_("'foo'"))
|
||||
lines.append(ae(t_type(tok_expr), '"STRING"'))
|
||||
lines.append(ae(t_val(tok_expr), '"foo"'))
|
||||
|
||||
elif name == 'handles template bootstrap properly':
|
||||
s1 = to_('"', tmpl=True)
|
||||
lines.append(ae(t_val(tok_i(s1, 0)), sx_str('"')))
|
||||
s2 = to_('"$', tmpl=True)
|
||||
lines.append(ae(t_val(tok_i(s2, 0)), sx_str('"')))
|
||||
lines.append(ae(t_val(tok_i(s2, 1)), '"$"'))
|
||||
s3 = to_('"${', tmpl=True)
|
||||
lines.append(ae(t_val(tok_i(s3, 0)), sx_str('"')))
|
||||
lines.append(ae(t_val(tok_i(s3, 1)), '"$"'))
|
||||
lines.append(ae(t_val(tok_i(s3, 2)), '"{"'))
|
||||
s4 = to_('"${"asdf"', tmpl=True)
|
||||
lines.append(ae(t_val(tok_i(s4, 0)), sx_str('"')))
|
||||
lines.append(ae(t_val(tok_i(s4, 1)), '"$"'))
|
||||
lines.append(ae(t_val(tok_i(s4, 2)), '"{"'))
|
||||
lines.append(ae(t_val(tok_i(s4, 3)), '"asdf"'))
|
||||
s5 = to_('"${"asdf"}"', tmpl=True)
|
||||
lines.append(ae(t_val(tok_i(s5, 0)), sx_str('"')))
|
||||
lines.append(ae(t_val(tok_i(s5, 1)), '"$"'))
|
||||
lines.append(ae(t_val(tok_i(s5, 2)), '"{"'))
|
||||
lines.append(ae(t_val(tok_i(s5, 3)), '"asdf"'))
|
||||
lines.append(ae(t_val(tok_i(s5, 4)), '"}"'))
|
||||
lines.append(ae(t_val(tok_i(s5, 5)), sx_str('"')))
|
||||
|
||||
elif name == 'handles whitespace properly':
|
||||
for src, expected in [
|
||||
(' ', 0), (' asdf', 1), (' asdf ', 2), ('asdf ', 2),
|
||||
('\n', 0), ('\nasdf', 1), ('\nasdf\n', 2), ('asdf\n', 2),
|
||||
('\r', 0), ('\rasdf', 1), ('\rasdf\r', 2), ('asdf\r', 2),
|
||||
('\t', 0), ('\tasdf', 1), ('\tasdf\t', 2), ('asdf\t', 2),
|
||||
]:
|
||||
lines.append(ae(list_len(to_(src)), str(expected)))
|
||||
|
||||
else:
|
||||
return None # not a tokenizer test we handle
|
||||
|
||||
lines.append(' )')
|
||||
return '\n'.join(lines)
|
||||
|
||||
|
||||
def generate_eval_only_test(test, idx):
|
||||
"""Generate SX deftest for no-HTML tests using eval-hs.
|
||||
Handles patterns:
|
||||
@@ -2321,6 +1894,267 @@ def generate_eval_only_test(test, idx):
|
||||
f' (assert (nil? (eval-hs "cookies.foo"))))'
|
||||
)
|
||||
|
||||
# Special case: cluster-36 socket URL tests. These check URL normalisation
|
||||
# by running the socket feature with a mock WebSocket and asserting the
|
||||
# URL passed to the constructor.
|
||||
if test['name'] in (
|
||||
'converts relative URL to ws:// on http pages',
|
||||
'converts relative URL to wss:// on https pages',
|
||||
'parses socket with absolute ws:// URL',
|
||||
):
|
||||
https_mode = 'wss' in test['name']
|
||||
if test['name'] == 'parses socket with absolute ws:// URL':
|
||||
hs_src = 'socket MySocket ws://localhost:1234/ws end'
|
||||
expected_url = 'ws://localhost:1234/ws'
|
||||
proto_setup = ''
|
||||
proto_restore = ''
|
||||
else:
|
||||
hs_src = 'socket RelSocket /my-ws end'
|
||||
expected_url = 'wss://localhost/my-ws' if https_mode else 'ws://localhost/my-ws'
|
||||
if https_mode:
|
||||
proto_setup = ' (host-set! (host-global "location") "protocol" "https:")\n'
|
||||
proto_restore = ' (host-set! (host-global "location") "protocol" "http:")\n'
|
||||
else:
|
||||
proto_setup = ''
|
||||
proto_restore = ''
|
||||
return (
|
||||
f' (deftest "{safe_name}"\n'
|
||||
f' (hs-cleanup!)\n'
|
||||
f' (host-set! (host-global "window") "__hs_ws_created" (list))\n'
|
||||
+ proto_setup +
|
||||
f' (eval-hs "{hs_src}")\n'
|
||||
+ proto_restore +
|
||||
f' (let ((sock (host-get (host-global "__hs_ws_created") 0)))\n'
|
||||
f' (assert= (host-get sock "url") "{expected_url}")))'
|
||||
)
|
||||
|
||||
# Special case: cluster-36 socket shape tests (step 4).
|
||||
# Test 4: namespaced sockets work — dotted name path walks window.
|
||||
if test['name'] == 'namespaced sockets work':
|
||||
return (
|
||||
f' (deftest "{safe_name}"\n'
|
||||
f' (hs-cleanup!)\n'
|
||||
f' (eval-hs "socket MyApp.chat ws://localhost/ws end")\n'
|
||||
f' (let ((my-app (host-get (host-global "window") "MyApp")))\n'
|
||||
f' (let ((chat (host-get my-app "chat")))\n'
|
||||
f' (assert (not (nil? (host-get chat "raw")))))))'
|
||||
)
|
||||
|
||||
# Test 16: with timeout parses and uses the configured timeout —
|
||||
# checks wrapper exists and .rpc is an object.
|
||||
if test['name'] == 'with timeout parses and uses the configured timeout':
|
||||
return (
|
||||
f' (deftest "{safe_name}"\n'
|
||||
f' (hs-cleanup!)\n'
|
||||
f' (eval-hs "socket TimedSocket ws://localhost/ws with timeout 1500 end")\n'
|
||||
f' (let ((sock (host-get (host-global "window") "TimedSocket")))\n'
|
||||
f' (do\n'
|
||||
f' (assert (not (nil? sock)))\n'
|
||||
f' (assert (not (nil? (host-get sock "rpc")))))))'
|
||||
)
|
||||
|
||||
# Special case: cluster-36 socket on-message tests (step 5).
|
||||
# Test 7: plain text message fires the handler.
|
||||
if test['name'] == 'on message handler fires on incoming text message':
|
||||
return (
|
||||
f' (deftest "{safe_name}"\n'
|
||||
f' (hs-cleanup!)\n'
|
||||
f' (eval-hs "socket TextSocket ws://localhost/ws on message set window.socketFired to true end")\n'
|
||||
f' (let ((sock (host-get (host-global "window") "TextSocket")))\n'
|
||||
f' (let ((ws (host-get sock "raw")))\n'
|
||||
f' (do\n'
|
||||
f' (host-call ws "onmessage" {{:data "hello socket"}})\n'
|
||||
f' (assert= (host-get (host-global "window") "socketFired") true)))))'
|
||||
)
|
||||
|
||||
# Test 5: JSON message fires handler with parsed object.
|
||||
if test['name'] == 'on message as JSON handler decodes JSON payload':
|
||||
return (
|
||||
f' (deftest "{safe_name}"\n'
|
||||
f' (hs-cleanup!)\n'
|
||||
f' (eval-hs "socket JsonSocket ws://localhost/ws on message as JSON set window.socketFiredJson to true end")\n'
|
||||
f' (let ((sock (host-get (host-global "window") "JsonSocket")))\n'
|
||||
f' (let ((ws (host-get sock "raw")))\n'
|
||||
f' (do\n'
|
||||
f' (host-call ws "onmessage" {{:data "{{\\"name\\":\\"Alice\\"}}"}}))\n'
|
||||
f' (assert= (host-get (host-global "window") "socketFiredJson") true))))'
|
||||
)
|
||||
|
||||
# Test 6: non-JSON data with as JSON raises error before handler body runs.
|
||||
# We verify the handler body (set window.strictFired) was NOT executed.
|
||||
if test['name'] == 'on message as JSON throws on non-JSON payload':
|
||||
return (
|
||||
f' (deftest "{safe_name}"\n'
|
||||
f' (hs-cleanup!)\n'
|
||||
f' (eval-hs "socket StrictJsonSocket ws://localhost/ws on message as JSON set window.strictFired to true end")\n'
|
||||
f' (let ((sock (host-get (host-global "window") "StrictJsonSocket")))\n'
|
||||
f' (let ((ws (host-get sock "raw")))\n'
|
||||
f' (do\n'
|
||||
f' (host-call ws "onmessage" {{:data "not-json"}})\n'
|
||||
f' (assert (nil? (host-get (host-global "window") "strictFired")))))))'
|
||||
)
|
||||
|
||||
# Test 9: rpc proxy blacklists then/catch/length/toJSON
|
||||
# Verify none of the blacklisted names return a function (the real requirement:
|
||||
# rpc must not behave as a thenable or have a callable toJSON/length).
|
||||
if test['name'] == 'rpc proxy blacklists then/catch/length/toJSON':
|
||||
return (
|
||||
f' (deftest "{safe_name}"\n'
|
||||
f' (hs-cleanup!)\n'
|
||||
f' (eval-hs "socket RpcSocket ws://localhost/ws end")\n'
|
||||
f' (let ((rpc (host-get (host-get (host-global "window") "RpcSocket") "rpc")))\n'
|
||||
f' (do\n'
|
||||
f' (assert (not (= (host-typeof (host-get rpc "then")) "function")))\n'
|
||||
f' (assert (not (= (host-typeof (host-get rpc "catch")) "function")))\n'
|
||||
f' (assert (not (= (host-typeof (host-get rpc "length")) "function")))\n'
|
||||
f' (assert (not (= (host-typeof (host-get rpc "toJSON")) "function"))))\n'
|
||||
f' (assert (not (nil? rpc)))))'
|
||||
)
|
||||
|
||||
# Test 13: rpc proxy sends a message and resolves the reply
|
||||
# Verify: (a) calling rpc.method triggers ws.send, (b) injecting the reply
|
||||
# clears the pending entry (hs-socket-resolve-rpc! ran).
|
||||
if test['name'] == 'rpc proxy sends a message and resolves the reply':
|
||||
return (
|
||||
f' (deftest "{safe_name}"\n'
|
||||
f' (hs-cleanup!)\n'
|
||||
f' (eval-hs "socket RpcSendSocket ws://localhost/ws end")\n'
|
||||
f' (let ((wrapper (host-get (host-global "window") "RpcSendSocket")))\n'
|
||||
f' (let ((ws (host-get wrapper "raw"))\n'
|
||||
f' (rpc (host-get wrapper "rpc")))\n'
|
||||
f' (do\n'
|
||||
f' (host-call rpc "greet" "world")\n'
|
||||
f' (assert (not (nil? (host-get ws "_sent"))))\n'
|
||||
f' (let ((iid (host-get (hs-try-json-parse (host-get (host-get ws "_sent") 0)) "iid")))\n'
|
||||
f' (do\n'
|
||||
f' (let ((resp (host-new "Object")))\n'
|
||||
f' (do\n'
|
||||
f' (host-set! resp "iid" iid)\n'
|
||||
f' (host-set! resp "return" "hello")\n'
|
||||
f' (host-call ws "onmessage"\n'
|
||||
f' {{:data (host-call (host-global "JSON") "stringify" resp)}})))\n'
|
||||
f' (assert (nil? (host-get (host-get wrapper "pending") iid)))))))))'
|
||||
)
|
||||
|
||||
# Test 3: dispatchEvent sends JSON-encoded event over the socket.
|
||||
# Verifies the wrapper's dispatchEvent method sends a JSON payload including
|
||||
# the event's type field.
|
||||
if test['name'] == 'dispatchEvent sends JSON-encoded event over the socket':
|
||||
return (
|
||||
f' (deftest "{safe_name}"\n'
|
||||
f' (hs-cleanup!)\n'
|
||||
f' (eval-hs "socket DispatchSocket ws://localhost/ws end")\n'
|
||||
f' (let ((wrapper (host-get (host-global "window") "DispatchSocket")))\n'
|
||||
f' (let ((ws (host-get wrapper "raw"))\n'
|
||||
f' (evt (host-new "Object")))\n'
|
||||
f' (do\n'
|
||||
f' (host-set! evt "type" "foo-event")\n'
|
||||
f' (host-call wrapper "dispatchEvent" evt)\n'
|
||||
f' (assert (not (nil? (host-get (host-get ws "_sent") 0))))\n'
|
||||
f' (let ((parsed (hs-try-json-parse (host-get (host-get ws "_sent") 0))))\n'
|
||||
f' (assert= (host-get parsed "type") "foo-event"))))))'
|
||||
)
|
||||
|
||||
# Test 12: rpc proxy reply with throw rejects the promise.
|
||||
# Verifies hs-socket-resolve-rpc! calls resolver.reject when msg.throw is set,
|
||||
# and clears the pending entry.
|
||||
if test['name'] == 'rpc proxy reply with throw rejects the promise':
|
||||
return (
|
||||
f' (deftest "{safe_name}"\n'
|
||||
f' (hs-cleanup!)\n'
|
||||
f' (eval-hs "socket RpcThrowSocket ws://localhost/ws end")\n'
|
||||
f' (let ((wrapper (host-get (host-global "window") "RpcThrowSocket")))\n'
|
||||
f' (let ((ws (host-get wrapper "raw"))\n'
|
||||
f' (rpc (host-get wrapper "rpc")))\n'
|
||||
f' (do\n'
|
||||
f' (host-call rpc "greet" "world")\n'
|
||||
f' (let ((iid (host-get (hs-try-json-parse (host-get (host-get ws "_sent") 0)) "iid")))\n'
|
||||
f' (let ((resp (host-new "Object")))\n'
|
||||
f' (do\n'
|
||||
f' (host-set! resp "iid" iid)\n'
|
||||
f' (host-set! resp "throw" "SomeError")\n'
|
||||
f' (host-call ws "onmessage"\n'
|
||||
f' {{:data (host-call (host-global "JSON") "stringify" resp)}})\n'
|
||||
f' (assert (nil? (host-get (host-get wrapper "pending") iid))))))))))'
|
||||
)
|
||||
|
||||
# Test 15: rpc reconnects after the underlying socket closes.
|
||||
# Verifies the lazy-reconnect path: after ws.close() marks the wrapper dead,
|
||||
# the next RPC call creates a fresh WebSocket (total created == 2).
|
||||
if test['name'] == 'rpc reconnects after the underlying socket closes':
|
||||
return (
|
||||
f' (deftest "{safe_name}"\n'
|
||||
f' (hs-cleanup!)\n'
|
||||
f' (host-set! (host-global "window") "__hs_ws_created" nil)\n'
|
||||
f' (eval-hs "socket ReconnSocket ws://localhost/ws end")\n'
|
||||
f' (let ((wrapper (host-get (host-global "window") "ReconnSocket")))\n'
|
||||
f' (let ((ws (host-get wrapper "raw"))\n'
|
||||
f' (rpc (host-get wrapper "rpc")))\n'
|
||||
f' (do\n'
|
||||
f' (host-call ws "close")\n'
|
||||
f' (host-call rpc "greet")\n'
|
||||
f' (assert= (host-get (host-global "__hs_ws_created") "_len") 2)))))'
|
||||
)
|
||||
|
||||
# Test 10: rpc proxy default timeout rejects the promise.
|
||||
# With a socket created using `with timeout 50`, calling rpc.neverReplies()
|
||||
# enqueues a fake setTimeout. After flushing timers, wrapper.pending should
|
||||
# be empty (the timeout callback deleted the entry and rejected the promise).
|
||||
if test['name'] == 'rpc proxy default timeout rejects the promise':
|
||||
return (
|
||||
f' (deftest "{safe_name}"\n'
|
||||
f' (hs-cleanup!)\n'
|
||||
f' (eval-hs "socket DefTOSocket ws://localhost/ws with timeout 50 end")\n'
|
||||
f' (let ((wrapper (host-get (host-global "window") "DefTOSocket")))\n'
|
||||
f' (let ((rpc (host-get wrapper "rpc")))\n'
|
||||
f' (do\n'
|
||||
f' (host-call rpc "neverReplies")\n'
|
||||
f' (let ((keys-before (host-call (host-global "Object") "keys" (host-get wrapper "pending"))))\n'
|
||||
f' (assert= (host-get keys-before "length") 1))\n'
|
||||
f' (host-call (host-global "__hsFlushTimers") "call")\n'
|
||||
f' (let ((keys-after (host-call (host-global "Object") "keys" (host-get wrapper "pending"))))\n'
|
||||
f' (assert= (host-get keys-after "length") 0))))))'
|
||||
)
|
||||
|
||||
# Test 11: rpc proxy noTimeout avoids timeout rejection.
|
||||
# rpc.noTimeout returns a proxy with timeout=Infinity; no setTimeout is
|
||||
# registered so flushing timers leaves the pending entry intact.
|
||||
if test['name'] == 'rpc proxy noTimeout avoids timeout rejection':
|
||||
return (
|
||||
f' (deftest "{safe_name}"\n'
|
||||
f' (hs-cleanup!)\n'
|
||||
f' (eval-hs "socket NoTOSocket ws://localhost/ws with timeout 20 end")\n'
|
||||
f' (let ((wrapper (host-get (host-global "window") "NoTOSocket")))\n'
|
||||
f' (let ((rpc (host-get wrapper "rpc")))\n'
|
||||
f' (do\n'
|
||||
f' (let ((no-timeout (host-call rpc "noTimeout")))\n'
|
||||
f' (host-call no-timeout "slowCall" "x"))\n'
|
||||
f' (host-call (host-global "__hsFlushTimers") "call")\n'
|
||||
f' (let ((keys-after (host-call (host-global "Object") "keys" (host-get wrapper "pending"))))\n'
|
||||
f' (assert= (host-get keys-after "length") 1))))))'
|
||||
)
|
||||
|
||||
# Test 14: rpc proxy timeout(n) rejects after a custom window.
|
||||
# rpc.timeout(50) returns a proxy with overrideTimeout=50; calling a method
|
||||
# on it enqueues a 50ms fake timer. After flushing, pending is empty.
|
||||
if test['name'] == 'rpc proxy timeout(n) rejects after a custom window':
|
||||
return (
|
||||
f' (deftest "{safe_name}"\n'
|
||||
f' (hs-cleanup!)\n'
|
||||
f' (eval-hs "socket CustomTOSocket ws://localhost/ws with timeout 60000 end")\n'
|
||||
f' (let ((wrapper (host-get (host-global "window") "CustomTOSocket")))\n'
|
||||
f' (let ((rpc (host-get wrapper "rpc")))\n'
|
||||
f' (do\n'
|
||||
f' (let ((timeout-fn (host-call rpc "timeout"))\n'
|
||||
f' (custom-proxy (host-call-fn timeout-fn (list 50))))\n'
|
||||
f' (host-call custom-proxy "willTimeOut"))\n'
|
||||
f' (let ((keys-before (host-call (host-global "Object") "keys" (host-get wrapper "pending"))))\n'
|
||||
f' (assert= (host-get keys-before "length") 1))\n'
|
||||
f' (host-call (host-global "__hsFlushTimers") "call")\n'
|
||||
f' (let ((keys-after (host-call (host-global "Object") "keys" (host-get wrapper "pending"))))\n'
|
||||
f' (assert= (host-get keys-after "length") 0))))))'
|
||||
)
|
||||
|
||||
# Special case: cluster-29 init events. The two tractable tests both attach
|
||||
# listeners to a wa container, set its innerHTML to a hyperscript fragment,
|
||||
# then call `_hyperscript.processNode(wa)`. Hand-roll deftests using
|
||||
@@ -2442,50 +2276,6 @@ def generate_eval_only_test(test, idx):
|
||||
f' )'
|
||||
)
|
||||
|
||||
# Special case: cluster-38 sourceInfo tests.
|
||||
if test['name'] == 'debug':
|
||||
return (
|
||||
f' (deftest "{safe_name}"\n'
|
||||
f' (assert= (hs-src "<button.foo/>") "<button.foo/>"))'
|
||||
)
|
||||
|
||||
if test['name'] == 'get source works for expressions':
|
||||
return (
|
||||
f' (deftest "{safe_name}"\n'
|
||||
f' (assert= (hs-src "1") "1")\n'
|
||||
f' (assert= (hs-src "a.b") "a.b")\n'
|
||||
f' (assert= (hs-src-at "a.b" (list :root)) "a")\n'
|
||||
f' (assert= (hs-src "a.b()") "a.b()")\n'
|
||||
f' (assert= (hs-src-at "a.b()" (list :root)) "a.b")\n'
|
||||
f' (assert= (hs-src-at "a.b()" (list :root :root)) "a")\n'
|
||||
f' (assert= (hs-src "<button.foo/>") "<button.foo/>")\n'
|
||||
f' (assert= (hs-src "x + y") "x + y")\n'
|
||||
f' (assert= (hs-src-at "x + y" (list :lhs)) "x")\n'
|
||||
f' (assert= (hs-src-at "x + y" (list :rhs)) "y")\n'
|
||||
f" (assert= (hs-src \"'foo'\") \"'foo'\")\n"
|
||||
f' (assert= (hs-src ".foo") ".foo")\n'
|
||||
f' (assert= (hs-src "#bar") "#bar"))'
|
||||
)
|
||||
|
||||
if test['name'] == 'get source works for statements':
|
||||
return (
|
||||
f' (deftest "{safe_name}"\n'
|
||||
f" (assert= (hs-src \"if true log 'it was true'\") \"if true log 'it was true'\")\n"
|
||||
f' (assert= (hs-src "for x in [1, 2, 3] log x then log x end") "for x in [1, 2, 3] log x then log x end"))'
|
||||
)
|
||||
|
||||
if test['name'] == 'get line works for statements':
|
||||
src = "if true\\n log 'it was true'\\n log 'it was true'"
|
||||
return (
|
||||
f' (deftest "{safe_name}"\n'
|
||||
f' (assert= (hs-line-at "{src}" (list)) "if true")\n'
|
||||
f" (assert= (hs-line-at \"{src}\" (list :true-branch)) \" log 'it was true'\")\n"
|
||||
f" (assert= (hs-line-at \"{src}\" (list :true-branch :next)) \" log 'it was true'\"))"
|
||||
)
|
||||
|
||||
if '_hyperscript.internals.tokenizer' in body:
|
||||
return generate_tokenizer_test(test, safe_name)
|
||||
|
||||
lines.append(f' (deftest "{safe_name}"')
|
||||
|
||||
assertions = []
|
||||
@@ -2497,20 +2287,13 @@ def generate_eval_only_test(test, idx):
|
||||
def emit_eval(hs_expr, expected_sx, extra_locals=None):
|
||||
"""Emit an assertion using eval-hs / eval-hs-locals / eval-hs-with-me
|
||||
as appropriate, given the window setups and any per-call locals.
|
||||
Uses assert-equal (deep equal?) when expected contains dicts; assert= otherwise.
|
||||
"""
|
||||
pairs = list(window_setups) + list(extra_locals or [])
|
||||
# assert= uses = (reference equality for dicts); assert-equal uses equal? (deep)
|
||||
use_deep = '{' in expected_sx
|
||||
if pairs:
|
||||
locals_sx = '(list ' + ' '.join(
|
||||
f'(list (quote {n}) {v})' for n, v in pairs
|
||||
) + ')'
|
||||
if use_deep:
|
||||
return f' (assert-equal {expected_sx} (eval-hs-locals "{hs_expr}" {locals_sx}))'
|
||||
return f' (assert= (eval-hs-locals "{hs_expr}" {locals_sx}) {expected_sx})'
|
||||
if use_deep:
|
||||
return f' (assert-equal {expected_sx} (eval-hs "{hs_expr}"))'
|
||||
return f' (assert= (eval-hs "{hs_expr}") {expected_sx})'
|
||||
|
||||
# Shared sub-pattern for run() call with optional String.raw and extra args:
|
||||
@@ -2911,20 +2694,6 @@ def generate_eval_only_test(test, idx):
|
||||
expected_sx = js_val_to_sx(be_match.group(1))
|
||||
assertions.append(f' (assert= (eval-hs "{hs_expr}") {expected_sx})')
|
||||
|
||||
# Pattern 2d: evalStatically() + toMatch(/cannot be evaluated statically/)
|
||||
# Handles: try { _hyperscript.parse("expr").evalStatically(); } catch(e) { return e.message; }
|
||||
# followed by: expect(msg).toMatch(/cannot be evaluated statically/)
|
||||
# Uses guard directly because try-call in hs-run-filtered.js is a registration stub
|
||||
# and assert-throws cannot catch exceptions during test execution.
|
||||
if not assertions:
|
||||
if 'evalStatically' in body and 'cannot be evaluated statically' in body:
|
||||
for m in re.finditer(
|
||||
r'_hyperscript\.parse\((["\x27])(.+?)\1\)\.evalStatically\(\)',
|
||||
body
|
||||
):
|
||||
hs_expr = extract_hs_expr(m.group(2))
|
||||
assertions.append(f' (guard (_e (true nil)) (hs-eval-statically "{hs_expr}") (error "hs-eval-statically did not throw for: {hs_expr}"))')
|
||||
|
||||
# Pattern 2e: run() with side-effects on window, checked via
|
||||
# const X = await evaluate(() => <js-expr>); expect(X).toBe(val)
|
||||
# The const holds the evaluated JS expr, not the run() return value,
|
||||
@@ -2986,16 +2755,7 @@ def generate_eval_only_test(test, idx):
|
||||
body, re.DOTALL
|
||||
):
|
||||
hs_expr = extract_hs_expr(m.group(2))
|
||||
assertions.append(f' (assert-throws (fn () (eval-hs "{hs_expr}")))')
|
||||
|
||||
# Pattern 4: error("expr").toBeNull() — parsing/eval must not throw
|
||||
if not assertions:
|
||||
for m in re.finditer(
|
||||
r'error\((["\x27])(.+?)\1\).*?toBeNull\(\)',
|
||||
body, re.DOTALL
|
||||
):
|
||||
hs_expr = extract_hs_expr(m.group(2))
|
||||
assertions.append(f' (hs-compile "{hs_expr}")')
|
||||
assertions.append(f' (assert-throws (eval-hs "{hs_expr}"))')
|
||||
|
||||
if not assertions:
|
||||
return None # Can't convert this body pattern
|
||||
@@ -3036,11 +2796,6 @@ def generate_compile_only_test(test):
|
||||
|
||||
def generate_test(test, idx):
|
||||
"""Generate SX deftest for an upstream test. Dispatches to Chai, PW, or eval-only."""
|
||||
if test['name'] in MANUAL_TEST_BODIES:
|
||||
name = sx_name(test['name'])
|
||||
lines = [f' (deftest "{name}"'] + MANUAL_TEST_BODIES[test['name']] + [' )']
|
||||
return '\n'.join(lines)
|
||||
|
||||
elements = parse_html(test['html'])
|
||||
|
||||
if not elements and not test.get('html', '').strip():
|
||||
@@ -3366,17 +3121,6 @@ output.append(' (nth _e 1)')
|
||||
output.append(' (raise _e))))')
|
||||
output.append(' (handler me-val))))))')
|
||||
output.append('')
|
||||
output.append(';; Evaluate a HS expression using evalStatically semantics:')
|
||||
output.append(';; only literal values (numbers, strings, booleans, null, time units)')
|
||||
output.append(';; succeed — any other expression raises "cannot be evaluated statically".')
|
||||
output.append('(define hs-eval-statically')
|
||||
output.append(' (fn (src)')
|
||||
output.append(' (let ((ast (hs-compile src)))')
|
||||
output.append(' (if (or (number? ast) (string? ast) (boolean? ast)')
|
||||
output.append(' (and (list? ast) (= (first ast) (quote null-literal))))')
|
||||
output.append(' (eval-hs src)')
|
||||
output.append(' (raise "cannot be evaluated statically")))))')
|
||||
output.append('')
|
||||
|
||||
# Group by category
|
||||
categories = OrderedDict()
|
||||
|
||||
Reference in New Issue
Block a user