giles
4cac08d56f
- Parser: contains/matches with ignoring case modifier - Compiler: contains-ignore-case? → hs-contains-ignore-case? - Compiler: matches-ignore-case? → hs-matches-ignore-case? - Runtime: downcase-based case-insensitive contains/matches Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
679 lines
21 KiB
Plaintext
679 lines
21 KiB
Plaintext
;; _hyperscript runtime shims
|
|
;;
|
|
;; Thin wrappers over web/lib/dom.sx and web/lib/browser.sx primitives
|
|
;; that implement hyperscript-specific semantics (async transparency,
|
|
;; class toggling, event waiting, iteration, type coercion).
|
|
;;
|
|
;; These are the functions that hs-to-sx (compiler.sx) emits calls to.
|
|
;; Each is a pure define — no platform dependency beyond the DOM/browser
|
|
;; primitives already available in the SX web platform.
|
|
|
|
;; ── Event handling ──────────────────────────────────────────────
|
|
|
|
;; Register an event listener. Returns unlisten function.
|
|
;; (hs-on target event-name handler) → unlisten-fn
|
|
(define
|
|
hs-each
|
|
(fn
|
|
(target action)
|
|
(if (list? target) (for-each action target) (action target))))
|
|
|
|
;; Register for every occurrence (no queuing — each fires independently).
|
|
;; Stock hyperscript queues by default; "every" disables queuing.
|
|
(define
|
|
hs-on
|
|
(fn (target event-name handler) (dom-listen target event-name handler)))
|
|
|
|
;; Run an initializer function immediately.
|
|
;; (hs-init thunk) — called at element boot time
|
|
(define
|
|
hs-on-every
|
|
(fn (target event-name handler) (dom-listen target event-name handler)))
|
|
|
|
;; ── 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-init (fn (thunk) (thunk)))
|
|
|
|
;; Wait for a DOM event on a target.
|
|
;; (hs-wait-for target event-name) — suspends until event fires
|
|
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
|
|
|
|
;; Wait for CSS transitions/animations to settle on an element.
|
|
(define
|
|
hs-wait-for
|
|
(fn
|
|
(target event-name)
|
|
(perform (list (quote io-wait-event) target event-name))))
|
|
|
|
;; ── Class manipulation ──────────────────────────────────────────
|
|
|
|
;; Toggle a single class on an element.
|
|
(define hs-settle (fn (target) (perform (list (quote io-settle) target))))
|
|
|
|
;; Toggle between two classes — exactly one is active at a time.
|
|
(define
|
|
hs-toggle-class!
|
|
(fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
|
|
|
|
;; Take a class from siblings — add to target, remove from others.
|
|
;; (hs-take! target cls) — like radio button class behavior
|
|
(define
|
|
hs-toggle-between!
|
|
(fn
|
|
(target cls1 cls2)
|
|
(if
|
|
(dom-has-class? target cls1)
|
|
(do (dom-remove-class target cls1) (dom-add-class target cls2))
|
|
(do (dom-remove-class target cls2) (dom-add-class target cls1)))))
|
|
|
|
;; ── DOM insertion ───────────────────────────────────────────────
|
|
|
|
;; Put content at a position relative to a target.
|
|
;; pos: "into" | "before" | "after"
|
|
(define
|
|
hs-toggle-style!
|
|
(fn
|
|
(target prop)
|
|
(let
|
|
((cur (dom-get-style target prop)))
|
|
(cond
|
|
((= prop "visibility")
|
|
(if
|
|
(= cur "hidden")
|
|
(dom-set-style target prop "visible")
|
|
(dom-set-style target prop "hidden")))
|
|
((or (= prop "display") (= prop "opacity"))
|
|
(if
|
|
(or (= cur "none") (= cur "0"))
|
|
(dom-set-style target prop "")
|
|
(dom-set-style target prop (if (= prop "display") "none" "0"))))
|
|
(true
|
|
(if
|
|
(or (= cur "") (= cur nil))
|
|
(dom-set-style target prop "hidden")
|
|
(dom-set-style target prop "")))))))
|
|
|
|
;; ── Navigation / traversal ──────────────────────────────────────
|
|
|
|
;; Navigate to a URL.
|
|
(define
|
|
hs-take!
|
|
(fn
|
|
(target kind name scope)
|
|
(let
|
|
((els (if scope (if (list? scope) scope (list scope)) (let ((parent (host-get target "parentNode"))) (if parent (dom-child-list parent) (list))))))
|
|
(if
|
|
(= kind "class")
|
|
(do
|
|
(for-each (fn (el) (dom-remove-class el name)) els)
|
|
(dom-add-class target name))
|
|
(do
|
|
(for-each (fn (el) (dom-remove-attr el name)) els)
|
|
(dom-set-attr target name "true"))))))
|
|
|
|
;; Find next sibling matching a selector (or any sibling).
|
|
(define
|
|
hs-put!
|
|
(fn
|
|
(value pos target)
|
|
(cond
|
|
((= pos "into") (dom-set-inner-html target value))
|
|
((= pos "before")
|
|
(dom-insert-adjacent-html target "beforebegin" value))
|
|
((= pos "after") (dom-insert-adjacent-html target "afterend" value))
|
|
((= pos "start") (dom-insert-adjacent-html target "afterbegin" value))
|
|
((= pos "end") (dom-insert-adjacent-html target "beforeend" value)))))
|
|
|
|
;; Find previous sibling matching a selector.
|
|
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
|
|
|
|
;; First element matching selector within a scope.
|
|
(define
|
|
hs-scroll!
|
|
(fn
|
|
(target position)
|
|
(host-call
|
|
target
|
|
"scrollIntoView"
|
|
(list
|
|
(cond
|
|
((= position "bottom") (dict :block "end"))
|
|
(true (dict :block "start")))))))
|
|
|
|
;; Last element matching selector.
|
|
(define
|
|
hs-halt!
|
|
(fn
|
|
(mode)
|
|
(when
|
|
event
|
|
(host-call event "preventDefault" (list))
|
|
(when (= mode "event") (host-call event "stopPropagation" (list))))))
|
|
|
|
;; First/last within a specific scope.
|
|
(define hs-select! (fn (target) (host-call target "select" (list))))
|
|
|
|
(define hs-reset! (fn (target) (host-call target "reset" (list))))
|
|
|
|
;; ── Iteration ───────────────────────────────────────────────────
|
|
|
|
;; Repeat a thunk N times.
|
|
(define
|
|
hs-next
|
|
(fn
|
|
(target sel)
|
|
(if
|
|
(= sel "*")
|
|
(dom-next-sibling target)
|
|
(let
|
|
((sibling (dom-next-sibling target)))
|
|
(define
|
|
find-next
|
|
(fn
|
|
(el)
|
|
(cond
|
|
((nil? el) nil)
|
|
((dom-matches? el sel) el)
|
|
(true (find-next (dom-next-sibling el))))))
|
|
(find-next sibling)))))
|
|
|
|
;; Repeat forever (until break — relies on exception/continuation).
|
|
(define
|
|
hs-previous
|
|
(fn
|
|
(target sel)
|
|
(if
|
|
(= sel "*")
|
|
(dom-get-prop target "previousElementSibling")
|
|
(let
|
|
((sibling (dom-get-prop target "previousElementSibling")))
|
|
(define
|
|
find-prev
|
|
(fn
|
|
(el)
|
|
(cond
|
|
((nil? el) nil)
|
|
((dom-matches? el sel) el)
|
|
(true (find-prev (dom-get-prop el "previousElementSibling"))))))
|
|
(find-prev sibling)))))
|
|
|
|
;; ── Fetch ───────────────────────────────────────────────────────
|
|
|
|
;; Fetch a URL, parse response according to format.
|
|
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
|
(define hs-query-all (fn (sel) (dom-query-all (dom-body) sel)))
|
|
|
|
;; ── Type coercion ───────────────────────────────────────────────
|
|
|
|
;; Coerce a value to a type by name.
|
|
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
|
(define
|
|
hs-query-first
|
|
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
|
|
|
|
;; ── Object creation ─────────────────────────────────────────────
|
|
|
|
;; Make a new object of a given type.
|
|
;; (hs-make type-name) — creates empty object/collection
|
|
(define
|
|
hs-query-last
|
|
(fn
|
|
(sel)
|
|
(let
|
|
((all (dom-query-all (dom-body) sel)))
|
|
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
|
|
|
;; ── 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-first (fn (scope sel) (dom-query-all scope 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-last
|
|
(fn
|
|
(scope sel)
|
|
(let
|
|
((all (dom-query-all scope sel)))
|
|
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
|
|
|
;; ── Transition ──────────────────────────────────────────────────
|
|
|
|
;; Transition a CSS property to a value, optionally with duration.
|
|
;; (hs-transition target prop value duration)
|
|
(define
|
|
hs-repeat-times
|
|
(fn
|
|
(n thunk)
|
|
(define
|
|
do-repeat
|
|
(fn (i) (when (< i n) (do (thunk) (do-repeat (+ i 1))))))
|
|
(do-repeat 0)))
|
|
|
|
(define
|
|
hs-repeat-forever
|
|
(fn
|
|
(thunk)
|
|
(define do-forever (fn () (thunk) (do-forever)))
|
|
(do-forever)))
|
|
|
|
(define
|
|
hs-fetch
|
|
(fn
|
|
(url format)
|
|
(let
|
|
((response (perform (list (quote io-fetch) url))))
|
|
(cond
|
|
((= format "json") (perform (list (quote io-parse-json) response)))
|
|
((= format "text") (perform (list (quote io-parse-text) response)))
|
|
((= format "html") (perform (list (quote io-parse-html) response)))
|
|
(true response)))))
|
|
|
|
(define
|
|
hs-coerce
|
|
(fn
|
|
(value type-name)
|
|
(cond
|
|
((= type-name "Int") (floor (+ value 0)))
|
|
((= type-name "Integer") (floor (+ value 0)))
|
|
((= type-name "Float") (+ value 0))
|
|
((= type-name "Number") (+ value 0))
|
|
((= type-name "String") (str value))
|
|
((= type-name "Bool") (if value true false))
|
|
((= type-name "Boolean") (if value true false))
|
|
((= type-name "Array") (if (list? value) value (list value)))
|
|
((= type-name "JSON") (str value))
|
|
((= type-name "Object") (if (string? value) value value))
|
|
((or (= type-name "Fixed") (string-contains? type-name "Fixed:"))
|
|
(let
|
|
((digits (if (string-contains? type-name ":") (parse-number (nth (split type-name ":") 1)) 0))
|
|
(num (+ value 0)))
|
|
(if
|
|
(= digits 0)
|
|
(str (floor num))
|
|
(let
|
|
((factor (reduce (fn (acc _) (* acc 10)) 1 (range 0 digits))))
|
|
(let
|
|
((rounded (/ (floor (+ (* num factor) 0.5)) factor)))
|
|
(str rounded))))))
|
|
((= type-name "HTML") (str value))
|
|
((= type-name "Values") value)
|
|
((= type-name "Fragment") (str value))
|
|
((= type-name "Date") (str value))
|
|
(true value))))
|
|
|
|
(define
|
|
hs-add
|
|
(fn (a b) (if (or (string? a) (string? b)) (str a b) (+ a b))))
|
|
|
|
(define
|
|
hs-make
|
|
(fn
|
|
(type-name)
|
|
(cond
|
|
((= type-name "Object") (dict))
|
|
((= type-name "Array") (list))
|
|
((= type-name "Set") (list))
|
|
((= type-name "Map") (dict))
|
|
(true (dict)))))
|
|
|
|
(define hs-install (fn (behavior-fn) (behavior-fn me)))
|
|
|
|
(define
|
|
hs-measure
|
|
(fn (target) (perform (list (quote io-measure) target))))
|
|
|
|
(define
|
|
hs-transition
|
|
(fn
|
|
(target prop value duration)
|
|
(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
|
|
(fn
|
|
(target prop from-val to-val duration)
|
|
(dom-set-style target prop (str from-val))
|
|
(when
|
|
duration
|
|
(dom-set-style
|
|
target
|
|
"transition"
|
|
(str prop " " (/ duration 1000) "s")))
|
|
(dom-set-style target prop (str to-val))
|
|
(when duration (hs-settle target))))
|
|
|
|
(define
|
|
hs-type-check
|
|
(fn
|
|
(value type-name)
|
|
(if
|
|
(nil? value)
|
|
true
|
|
(cond
|
|
((= type-name "Number") (number? value))
|
|
((= type-name "String") (string? value))
|
|
((= type-name "Boolean") (or (= value true) (= value false)))
|
|
((= type-name "Array") (list? value))
|
|
((= type-name "Object") (dict? value))
|
|
(true true)))))
|
|
|
|
|
|
|
|
|
|
|
|
(define
|
|
hs-type-check-strict
|
|
(fn
|
|
(value type-name)
|
|
(if (nil? value) false (hs-type-check value type-name))))
|
|
|
|
(define
|
|
hs-strict-eq
|
|
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
|
|
;; ── Sandbox/test runtime additions ──────────────────────────────
|
|
;; Property access — dot notation and .length
|
|
(define
|
|
hs-eq-ignore-case
|
|
(fn (a b) (= (downcase (str a)) (downcase (str b)))))
|
|
;; DOM query stub — sandbox returns empty list
|
|
(define
|
|
hs-contains-ignore-case?
|
|
(fn
|
|
(haystack needle)
|
|
(contains? (downcase (str haystack)) (downcase (str needle)))))
|
|
;; Method dispatch — obj.method(args)
|
|
(define
|
|
hs-falsy?
|
|
(fn
|
|
(v)
|
|
(cond
|
|
((nil? v) true)
|
|
((= v false) true)
|
|
((and (string? v) (= v "")) true)
|
|
((and (list? v) (= (len v) 0)) true)
|
|
((= v 0) true)
|
|
(true false))))
|
|
|
|
;; ── 0.9.90 features ─────────────────────────────────────────────
|
|
;; beep! — debug logging, returns value unchanged
|
|
(define
|
|
hs-matches?
|
|
(fn
|
|
(target pattern)
|
|
(if
|
|
(string? target)
|
|
(if (= pattern ".*") true (string-contains? target pattern))
|
|
false)))
|
|
;; Property-based is — check obj.key truthiness
|
|
(define
|
|
hs-contains?
|
|
(fn
|
|
(collection item)
|
|
(cond
|
|
((nil? collection) false)
|
|
((string? collection) (string-contains? collection (str item)))
|
|
((list? collection)
|
|
(if
|
|
(list? item)
|
|
(filter (fn (x) (hs-contains? collection x)) item)
|
|
(if
|
|
(= (len collection) 0)
|
|
false
|
|
(if
|
|
(= (first collection) item)
|
|
true
|
|
(hs-contains? (rest collection) item)))))
|
|
(true false))))
|
|
;; Array slicing (inclusive both ends)
|
|
(define precedes? (fn (a b) (< (str a) (str b))))
|
|
;; Collection: sorted by
|
|
(define
|
|
hs-empty?
|
|
(fn
|
|
(v)
|
|
(cond
|
|
((nil? v) true)
|
|
((string? v) (= (len v) 0))
|
|
((list? v) (= (len v) 0))
|
|
((dict? v) (= (len (keys v)) 0))
|
|
(true false))))
|
|
;; Collection: sorted by descending
|
|
(define
|
|
hs-empty-target!
|
|
(fn
|
|
(target)
|
|
(cond
|
|
((list? target) (for-each (fn (el) (hs-empty-target! el)) target))
|
|
((nil? target) nil)
|
|
(true
|
|
(let
|
|
((tag (dom-get-prop target "tagName")))
|
|
(cond
|
|
((or (= tag "INPUT") (= tag "TEXTAREA"))
|
|
(let
|
|
((input-type (dom-get-prop target "type")))
|
|
(if
|
|
(or (= input-type "checkbox") (= input-type "radio"))
|
|
(dom-set-prop target "checked" false)
|
|
(dom-set-prop target "value" ""))))
|
|
((= tag "FORM") (dom-set-inner-html target ""))
|
|
(true (dom-set-inner-html target ""))))))))
|
|
;; Collection: split by
|
|
(define hs-first (fn (lst) (first lst)))
|
|
;; Collection: joined by
|
|
(define hs-last (fn (lst) (last lst)))
|
|
|
|
(define
|
|
hs-template
|
|
(fn
|
|
(raw)
|
|
(let
|
|
((result "") (i 0) (n (len raw)))
|
|
(define
|
|
tpl-loop
|
|
(fn
|
|
()
|
|
(when
|
|
(< i n)
|
|
(let
|
|
((ch (nth raw i)))
|
|
(if
|
|
(and (= ch "$") (< (+ i 1) n))
|
|
(if
|
|
(= (nth raw (+ i 1)) "{")
|
|
(let
|
|
((start (+ i 2)))
|
|
(define
|
|
find-close
|
|
(fn
|
|
(j depth)
|
|
(if
|
|
(>= j n)
|
|
j
|
|
(if
|
|
(= (nth raw j) "}")
|
|
(if
|
|
(= depth 1)
|
|
j
|
|
(find-close (+ j 1) (- depth 1)))
|
|
(if
|
|
(= (nth raw j) "{")
|
|
(find-close (+ j 1) (+ depth 1))
|
|
(find-close (+ j 1) depth))))))
|
|
(let
|
|
((close (find-close start 1)))
|
|
(let
|
|
((expr-src (slice raw start close)))
|
|
(do
|
|
(set!
|
|
result
|
|
(str
|
|
result
|
|
(cek-eval (hs-to-sx (hs-compile expr-src)))))
|
|
(set! i (+ close 1))
|
|
(tpl-loop)))))
|
|
(let
|
|
((start (+ i 1)))
|
|
(define
|
|
read-id
|
|
(fn
|
|
(j)
|
|
(if
|
|
(and
|
|
(< j n)
|
|
(let
|
|
((c (nth raw j)))
|
|
(or
|
|
(and (>= c "a") (<= c "z"))
|
|
(and (>= c "A") (<= c "Z"))
|
|
(and (>= c "0") (<= c "9"))
|
|
(= c "_")
|
|
(= c "."))))
|
|
(read-id (+ j 1))
|
|
j)))
|
|
(let
|
|
((end (read-id start)))
|
|
(let
|
|
((ident (slice raw start end)))
|
|
(do
|
|
(set!
|
|
result
|
|
(str
|
|
result
|
|
(cek-eval (hs-to-sx (hs-compile ident)))))
|
|
(set! i end)
|
|
(tpl-loop))))))
|
|
(do
|
|
(set! result (str result ch))
|
|
(set! i (+ i 1))
|
|
(tpl-loop)))))))
|
|
(do (tpl-loop) result))))
|
|
|
|
(define
|
|
hs-make-object
|
|
(fn
|
|
(pairs)
|
|
(let
|
|
((d {}))
|
|
(do
|
|
(for-each
|
|
(fn (pair) (dict-set! d (first pair) (nth pair 1)))
|
|
pairs)
|
|
d))))
|
|
|
|
(define
|
|
hs-method-call
|
|
(fn
|
|
(obj method &rest args)
|
|
(cond
|
|
((= method "map") (map (first args) obj))
|
|
((= method "push") (do (append! obj (first args)) obj))
|
|
((= method "filter") (filter (first args) obj))
|
|
((= method "join") (join obj (first args)))
|
|
((= method "indexOf")
|
|
(let
|
|
((item (first args)))
|
|
(define
|
|
idx-loop
|
|
(fn
|
|
(lst i)
|
|
(if
|
|
(= (len lst) 0)
|
|
-1
|
|
(if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
|
|
(idx-loop obj 0)))
|
|
(true nil))))
|
|
|
|
(define hs-beep (fn (v) v))
|
|
|
|
(define hs-prop-is (fn (obj key) (not (hs-falsy? (host-get obj key)))))
|
|
|
|
(define
|
|
hs-slice
|
|
(fn
|
|
(col start end)
|
|
(let
|
|
((s (if (nil? start) 0 start))
|
|
(e (if (nil? end) (len col) (+ end 1))))
|
|
(slice col s e))))
|
|
|
|
(define
|
|
hs-sorted-by
|
|
(fn
|
|
(col key-fn)
|
|
(let
|
|
((pairs (map (fn (item) (list (key-fn item) item)) col)))
|
|
(map
|
|
(fn (p) (nth p 1))
|
|
(sort (fn (a b) (if (< (first a) (first b)) true false)) pairs)))))
|
|
|
|
(define
|
|
hs-sorted-by-desc
|
|
(fn
|
|
(col key-fn)
|
|
(let
|
|
((pairs (map (fn (item) (list (key-fn item) item)) col)))
|
|
(map
|
|
(fn (p) (nth p 1))
|
|
(sort (fn (a b) (if (> (first a) (first b)) true false)) pairs)))))
|
|
|
|
(define hs-split-by (fn (s sep) (split s sep)))
|
|
|
|
(define hs-joined-by (fn (col sep) (join sep col)))
|
|
|
|
(define
|
|
hs-sorted-by
|
|
(fn
|
|
(col key-fn)
|
|
(let
|
|
((decorated (map (fn (item) (list (key-fn item) item)) col)))
|
|
(let
|
|
((sorted-dec (sort (map first decorated))))
|
|
(define
|
|
reorder
|
|
(fn
|
|
(keys acc remaining)
|
|
(if
|
|
(= (len keys) 0)
|
|
acc
|
|
(let
|
|
((k (first keys)))
|
|
(define
|
|
find-item
|
|
(fn
|
|
(lst)
|
|
(if
|
|
(= (len lst) 0)
|
|
nil
|
|
(if
|
|
(= (first (first lst)) k)
|
|
(first lst)
|
|
(find-item (rest lst))))))
|
|
(let
|
|
((found (find-item remaining)))
|
|
(reorder
|
|
(rest keys)
|
|
(append acc (list (nth found 1)))
|
|
(filter (fn (x) (not (= x found))) remaining)))))))
|
|
(reorder sorted-dec (list) decorated)))))
|
|
|
|
(define
|
|
hs-sorted-by-desc
|
|
(fn (col key-fn) (reverse (hs-sorted-by col key-fn))))
|