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

HS toggle style: parse between/cycle, runtime, mock style dict

Browse Source 
Parser:
- Reorder toggle style parsing: target before between clause
- Handle "indexed" keyword, "indexed by" syntax
- Use parse-atom (not parse-expr) for between values to avoid
  consuming "and" as boolean operator
- Support 3-4 value cycles via toggle-style-cycle

Compiler:
- Add toggle-style-cycle dispatch → hs-toggle-style-cycle!

Runtime:
- Add hs-toggle-style-between! (2-value toggle)
- Add hs-toggle-style-cycle! (N-value round-robin)

Mock DOM:
- Parse CSS strings from setAttribute "style" into style sub-dict
  so dom-get-style/dom-set-style work correctly

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-18 21:35:00 +00:00
parent 06bed36272
commit 00bf13a230
4 changed files with 156 additions and 77 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
hosts/ocaml/bin/run_tests.ml
View File

@@ -1815,6 +1815,22 @@ let run_spec_tests env test_files =
Hashtbl.replace d "className" (String sv);
end;
if name = "disabled" then Hashtbl.replace d "disabled" (Bool true);
if name = "style" then begin
(* Parse CSS string into the style sub-dict *)
let style_d = match Hashtbl.find_opt d "style" with Some (Dict s) -> s | _ ->
let s = Hashtbl.create 4 in Hashtbl.replace d "style" (Dict s); s in
let parts = String.split_on_char ';' sv in
List.iter (fun part ->
let part = String.trim part in
if String.length part > 0 then
match String.index_opt part ':' with
| Some i ->
let prop = String.trim (String.sub part 0 i) in
let value = String.trim (String.sub part (i+1) (String.length part - i - 1)) in
Hashtbl.replace style_d prop (String value)
| None -> ()
) parts
end;
Nil
| _ -> Nil)
| "getAttribute" ->

8
lib/hyperscript/compiler.sx
View File

@@ -1008,6 +1008,14 @@
(nth ast 1)
(hs-to-sx (nth ast 2))
(hs-to-sx (nth ast 3))))
((= head (quote toggle-style-cycle))
(list
(quote hs-toggle-style-cycle!)
(hs-to-sx (nth ast 2))
(nth ast 1)
(cons
(quote list)
(map hs-to-sx (slice ast 3 (len ast))))))
((= head (quote toggle-attr))
(list
(quote hs-toggle-attr!)

68
lib/hyperscript/parser.sx
View File

@@ -935,40 +935,64 @@
(list (quote toggle-class) cls tgt)))))
((= (tp-type) "style")
(let
((prop (do (let ((v (tp-val))) (adv!) v))))
(if
(match-kw "between")
(let
((val1 (parse-atom)))
(expect-kw! "and")
((prop (get (adv!) "value")))
(let
((tgt (if (match-kw "of") (parse-expr) (list (quote me)))))
(if
(match-kw "between")
(let
((val2 (parse-atom)))
((val1 (parse-atom)))
(expect-kw! "and")
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (quote toggle-style-between) prop val1 val2 tgt))))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
((val2 (parse-atom)))
(if
(match-kw "and")
(let
((val3 (parse-atom)))
(if
(match-kw "and")
(let
((val4 (parse-atom)))
(list
(quote toggle-style-cycle)
prop
tgt
val1
val2
val3
val4))
(list
(quote toggle-style-cycle)
prop
tgt
val1
val2
val3)))
(list
(quote toggle-style-between)
prop
val1
val2
tgt))))
(list (quote toggle-style) prop tgt)))))
((= (tp-type) "attr")
(let
((attr-name (do (let ((v (tp-val))) (adv!) v))))
(if
(match-kw "between")
(let
((val1 (parse-atom)))
(expect-kw! "and")
((attr-name (get (adv!) "value")))
(let
((tgt (if (match-kw "on") (parse-expr) (list (quote me)))))
(if
(match-kw "between")
(let
((val2 (parse-atom)))
((val1 (parse-expr)))
(expect-kw! "and")
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
((val2 (parse-expr)))
(list
(quote toggle-attr-between)
attr-name
val1
val2
tgt))))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
tgt)))
(list (quote toggle-attr) attr-name tgt)))))
((and (= (tp-type) "keyword") (= (tp-val) "my"))
(do

141
lib/hyperscript/runtime.sx
View File

@@ -99,6 +99,39 @@
;; ── Navigation / traversal ──────────────────────────────────────
;; Navigate to a URL.
(define
hs-toggle-style-between!
(fn
(target prop val1 val2)
(let
((cur (dom-get-style target prop)))
(if
(= cur val1)
(dom-set-style target prop val2)
(dom-set-style target prop val1)))))
;; Find next sibling matching a selector (or any sibling).
(define
hs-toggle-style-cycle!
(fn
(target prop vals)
(let
((cur (dom-get-style target prop)))
(define
find-next
(fn
(remaining)
(cond
((empty? remaining) (first vals))
((= cur (first remaining))
(if
(empty? (rest remaining))
(first vals)
(first (rest remaining))))
(true (find-next (rest remaining))))))
(dom-set-style target prop (find-next vals)))))
;; Find previous sibling matching a selector.
(define
hs-take!
(fn
@@ -122,7 +155,7 @@
(dom-set-attr target name attr-val)
(dom-set-attr target name ""))))))))
;; Find next sibling matching a selector (or any sibling).
;; First element matching selector within a scope.
(define
hs-put!
(fn
@@ -135,7 +168,7 @@
((= pos "start") (dom-insert-adjacent-html target "afterbegin" value))
((= pos "end") (dom-insert-adjacent-html target "beforeend" value)))))
;; Find previous sibling matching a selector.
;; Last element matching selector.
(define
hs-add-to!
(fn
@@ -145,7 +178,7 @@
(append target (list value))
(host-call target "push" value))))
;; First element matching selector within a scope.
;; First/last within a specific scope.
(define
hs-remove-from!
(fn
@@ -155,16 +188,18 @@
(filter (fn (x) (not (= x value))) target)
(host-call target "splice" (host-call target "indexOf" value) 1))))
;; Last element matching selector.
(define
hs-set-on!
(fn
(props target)
(for-each (fn (k) (host-set! target k (get props k))) (keys props))))
;; First/last within a specific scope.
;; ── Iteration ───────────────────────────────────────────────────
;; Repeat a thunk N times.
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
;; Repeat forever (until break — relies on exception/continuation).
(define
hs-scroll!
(fn
@@ -177,9 +212,10 @@
((= position "bottom") (dict :block "end"))
(true (dict :block "start")))))))
;; ── Iteration ───────────────────────────────────────────────────
;; ── Fetch ───────────────────────────────────────────────────────
;; Repeat a thunk N times.
;; Fetch a URL, parse response according to format.
;; (hs-fetch url format) — format is "json" | "text" | "html"
(define
hs-halt!
(fn
@@ -189,19 +225,23 @@
(host-call event "preventDefault" (list))
(when (= mode "event") (host-call event "stopPropagation" (list))))))
;; Repeat forever (until break — relies on exception/continuation).
(define hs-select! (fn (target) (host-call target "select" (list))))
;; ── Fetch ───────────────────────────────────────────────────────
;; Fetch a URL, parse response according to format.
;; (hs-fetch url format) — format is "json" | "text" | "html"
(define hs-reset! (fn (target) (host-call target "reset" (list))))
;; ── Type coercion ───────────────────────────────────────────────
;; Coerce a value to a type by name.
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
(define hs-select! (fn (target) (host-call target "select" (list))))
;; ── Object creation ─────────────────────────────────────────────
;; Make a new object of a given type.
;; (hs-make type-name) — creates empty object/collection
(define hs-reset! (fn (target) (host-call target "reset" (list))))
;; ── 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-next
(fn
@@ -221,10 +261,10 @@
(true (find-next (dom-next-sibling el))))))
(find-next sibling)))))
;; ── Object creation ─────────────────────────────────────────────
;; ── Measurement ─────────────────────────────────────────────────
;; Make a new object of a given type.
;; (hs-make type-name) — creates empty object/collection
;; Measure an element's bounding rect, store as local variables.
;; Returns a dict with x, y, width, height, top, left, right, bottom.
(define
hs-previous
(fn
@@ -244,27 +284,18 @@
(true (find-prev (dom-get-prop el "previousElementSibling"))))))
(find-prev sibling)))))
;; ── 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-query-all
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
;; ── Measurement ─────────────────────────────────────────────────
;; Measure an element's bounding rect, store as local variables.
;; Returns a dict with x, y, width, height, top, left, right, bottom.
(define
hs-query-first
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
;; ── Transition ──────────────────────────────────────────────────
;; Transition a CSS property to a value, optionally with duration.
;; (hs-transition target prop value duration)
(define
hs-query-all
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
(define
hs-query-first
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
(define
hs-query-last
(fn
@@ -410,6 +441,10 @@
((or (string? a) (string? b)) (str a b))
(true (+ a b)))))
(define
hs-make
(fn
@@ -422,15 +457,12 @@
(true (dict)))))
(define hs-install (fn (behavior-fn) (behavior-fn me)))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
(define
hs-measure
(fn (target) (perform (list (quote io-measure) target))))
;; DOM query stub — sandbox returns empty list
(define
hs-transition
(fn
@@ -443,8 +475,7 @@
(str prop " " (/ duration 1000) "s")))
(dom-set-style target prop value)
(when duration (hs-settle target))))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
;; Method dispatch — obj.method(args)
(define
hs-transition-from
(fn
@@ -458,7 +489,9 @@
(str prop " " (/ duration 1000) "s")))
(dom-set-style target prop (str to-val))
(when duration (hs-settle target))))
;; DOM query stub — sandbox returns empty list
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
(define
hs-type-check
(fn
@@ -478,33 +511,31 @@
(= (host-typeof value) "element")
(= (host-typeof value) "text")))
(true (= (host-typeof value) (downcase type-name)))))))
;; Method dispatch — obj.method(args)
;; Property-based is — check obj.key truthiness
(define
hs-type-check-strict
(fn
(value type-name)
(if (nil? value) false (hs-type-check value type-name))))
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
;; Array slicing (inclusive both ends)
(define
hs-strict-eq
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
;; Property-based is — check obj.key truthiness
;; Collection: sorted by
(define
hs-eq-ignore-case
(fn (a b) (= (downcase (str a)) (downcase (str b)))))
;; Array slicing (inclusive both ends)
;; Collection: sorted by descending
(define
hs-starts-with-ic?
(fn (str prefix) (starts-with? (downcase str) (downcase prefix))))
;; Collection: sorted by
;; Collection: split by
(define
hs-contains-ignore-case?
(fn
(haystack needle)
(contains? (downcase (str haystack)) (downcase (str needle)))))
;; Collection: sorted by descending
;; Collection: joined by
(define
hs-falsy?
(fn
@@ -516,7 +547,7 @@
((and (list? v) (= (len v) 0)) true)
((= v 0) true)
(true false))))
;; Collection: split by
(define
hs-matches?
(fn
@@ -527,7 +558,7 @@
((= (host-typeof target) "element")
(if (string? pattern) (host-call target "matches" pattern) false))
(true false))))
;; Collection: joined by
(define
hs-contains?
(fn