HS: append command, list stringify as comma-separated
Compiler: - append to symbol → (set! target (hs-append target value)) - append to DOM → (hs-append! value target) Runtime: - hs-append: pure function for string concat and list append - hs-append!: DOM insertAdjacentHTML for element targets Mock DOM: - dom_stringify handles List by joining elements with commas (matching JS Array.toString() behavior) Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -1644,13 +1644,14 @@ let run_spec_tests env test_files =
|
||||
| _ -> Nil);
|
||||
|
||||
(* Stringify a value for DOM string properties *)
|
||||
let dom_stringify = function
|
||||
let rec dom_stringify = function
|
||||
| String s -> String s
|
||||
| Number n ->
|
||||
let i = int_of_float n in
|
||||
if float_of_int i = n then String (string_of_int i) else String (string_of_float n)
|
||||
| Bool true -> String "true"
|
||||
| Bool false -> String "false"
|
||||
| List l -> String (String.concat "," (List.map (fun v -> match dom_stringify v with String s -> s | _ -> "") l))
|
||||
| Nil -> String ""
|
||||
| v -> String (Sx_types.inspect v)
|
||||
in
|
||||
|
||||
@@ -1143,10 +1143,13 @@
|
||||
((= head (quote go))
|
||||
(list (quote hs-navigate!) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote append!))
|
||||
(list
|
||||
(quote dom-append)
|
||||
(hs-to-sx (nth ast 2))
|
||||
(hs-to-sx (nth ast 1))))
|
||||
(let
|
||||
((tgt (hs-to-sx (nth ast 2)))
|
||||
(val (hs-to-sx (nth ast 1))))
|
||||
(if
|
||||
(symbol? tgt)
|
||||
(list (quote set!) tgt (list (quote hs-append) tgt val))
|
||||
(list (quote hs-append!) val tgt))))
|
||||
((= head (quote tell))
|
||||
(let
|
||||
((tgt (hs-to-sx (nth ast 1))))
|
||||
|
||||
@@ -393,16 +393,29 @@
|
||||
(true (do-loop (rest remaining))))))))
|
||||
(do-loop items))))
|
||||
|
||||
(begin
|
||||
(define
|
||||
hs-append
|
||||
(fn
|
||||
(target value)
|
||||
(cond
|
||||
((string? target) (str target value))
|
||||
((list? target) (append target (list value)))
|
||||
(true (str target value)))))
|
||||
(define
|
||||
hs-append!
|
||||
(fn (value target) (dom-insert-adjacent-html target "beforeend" value))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define
|
||||
hs-fetch
|
||||
(fn
|
||||
(url format)
|
||||
(perform (list "io-fetch" url (if format format "text")))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define
|
||||
hs-coerce
|
||||
(fn
|
||||
@@ -491,7 +504,8 @@
|
||||
(map (fn (k) (list k (get value k))) (keys value))
|
||||
value))
|
||||
(true value))))
|
||||
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
(define
|
||||
hs-add
|
||||
(fn
|
||||
@@ -501,8 +515,7 @@
|
||||
((list? b) (cons a b))
|
||||
((or (string? a) (string? b)) (str a b))
|
||||
(true (+ a b)))))
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
(define
|
||||
hs-make
|
||||
(fn
|
||||
@@ -513,15 +526,15 @@
|
||||
((= type-name "Set") (list))
|
||||
((= type-name "Map") (dict))
|
||||
(true (dict)))))
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
(define hs-install (fn (behavior-fn) (behavior-fn me)))
|
||||
;; Method dispatch — obj.method(args)
|
||||
(define
|
||||
hs-measure
|
||||
(fn (target) (perform (list (quote io-measure) target))))
|
||||
(define hs-install (fn (behavior-fn) (behavior-fn me)))
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
(define
|
||||
hs-measure
|
||||
(fn (target) (perform (list (quote io-measure) target))))
|
||||
;; Property-based is — check obj.key truthiness
|
||||
(define
|
||||
hs-transition
|
||||
(fn
|
||||
@@ -534,7 +547,7 @@
|
||||
(str prop " " (/ duration 1000) "s")))
|
||||
(dom-set-style target prop value)
|
||||
(when duration (hs-settle target))))
|
||||
;; Property-based is — check obj.key truthiness
|
||||
;; Array slicing (inclusive both ends)
|
||||
(define
|
||||
hs-transition-from
|
||||
(fn
|
||||
@@ -548,7 +561,7 @@
|
||||
(str prop " " (/ duration 1000) "s")))
|
||||
(dom-set-style target prop (str to-val))
|
||||
(when duration (hs-settle target))))
|
||||
;; Array slicing (inclusive both ends)
|
||||
;; Collection: sorted by
|
||||
(define
|
||||
hs-type-check
|
||||
(fn
|
||||
@@ -568,21 +581,21 @@
|
||||
(= (host-typeof value) "element")
|
||||
(= (host-typeof value) "text")))
|
||||
(true (= (host-typeof value) (downcase type-name)))))))
|
||||
;; Collection: sorted by
|
||||
;; Collection: sorted by descending
|
||||
(define
|
||||
hs-type-check-strict
|
||||
(fn
|
||||
(value type-name)
|
||||
(if (nil? value) false (hs-type-check value type-name))))
|
||||
;; Collection: sorted by descending
|
||||
;; Collection: split by
|
||||
(define
|
||||
hs-strict-eq
|
||||
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
|
||||
;; Collection: split by
|
||||
;; Collection: joined by
|
||||
(define
|
||||
hs-eq-ignore-case
|
||||
(fn (a b) (= (downcase (str a)) (downcase (str b)))))
|
||||
;; Collection: joined by
|
||||
|
||||
(define
|
||||
hs-starts-with-ic?
|
||||
(fn (str prefix) (starts-with? (downcase str) (downcase prefix))))
|
||||
|
||||
Reference in New Issue
Block a user