From 00bf13a2306797ce11d74439f68d5f61b01e7fff Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 18 Apr 2026 21:35:00 +0000 Subject: [PATCH] HS toggle style: parse between/cycle, runtime, mock style dict MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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) --- hosts/ocaml/bin/run_tests.ml | 16 ++++ lib/hyperscript/compiler.sx | 8 ++ lib/hyperscript/parser.sx | 68 +++++++++++------ lib/hyperscript/runtime.sx | 141 +++++++++++++++++++++-------------- 4 files changed, 156 insertions(+), 77 deletions(-) diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml index 038ba6f4..8e4ff395 100644 --- a/hosts/ocaml/bin/run_tests.ml +++ b/hosts/ocaml/bin/run_tests.ml @@ -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" -> diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index 8512f149..f1784c70 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -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!) diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index e854e59f..426ede76 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -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 diff --git a/lib/hyperscript/runtime.sx b/lib/hyperscript/runtime.sx index 27962e61..380353bb 100644 --- a/lib/hyperscript/runtime.sx +++ b/lib/hyperscript/runtime.sx @@ -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