;; _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
(begin
  (define _hs-config-log-all false)
  (define _hs-log-captured (list))
  (define
    hs-set-log-all!
    (fn (flag) (set! _hs-config-log-all (if flag true false))))
  (define hs-get-log-captured (fn () _hs-log-captured))
  (define
    hs-clear-log-captured!
    (fn () (begin (set! _hs-log-captured (list)) nil)))
  (define
    hs-log-event!
    (fn
      (msg)
      (when
        _hs-config-log-all
        (begin
          (set! _hs-log-captured (append _hs-log-captured (list msg)))
          (host-call (host-global "console") "log" msg)
          nil)))))

;; Run an initializer function immediately.
;; (hs-init thunk) — called at element boot time
(define
  hs-each
  (fn
    (target action)
    (if (list? target) (for-each action target) (action target))))

;; Run an initializer function immediately.
;; (hs-init thunk) — called at element boot time
(define meta (host-new "Object"))

;; ── 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-every
  (fn (target event-name handler) (dom-listen target event-name handler)))

;; Throttle: drops events that arrive within the window. First event fires
;; immediately; subsequent events within `ms` of the previous fire are dropped.
;; Returns a wrapped handler suitable for hs-on / hs-on-every.
(define
  hs-throttle!
  (fn
    (handler ms)
    (let
      ((__hs-last-fire 0))
      (fn
        (event)
        (let
          ((__hs-now (host-call (host-global "Date") "now")))
          (when
            (>= (- __hs-now __hs-last-fire) ms)
            (set! __hs-last-fire __hs-now)
            (handler event)))))))

;; Debounce: waits until `ms` has elapsed since the last event before firing.
;; In our synchronous test mock no time passes, so the timer fires immediately
;; via setTimeout(_, 0); the wrapped handler still gets called once per burst.
(define
  hs-debounce!
  (fn
    (handler ms)
    (let
      ((__hs-timer nil))
      (fn
        (event)
        (when __hs-timer (host-call (host-global "window") "clearTimeout" __hs-timer))
        (set! __hs-timer
          (host-call (host-global "window") "setTimeout"
            (host-new-function (list "ev") "return arguments[0](arguments[1]);")
            ms handler event))))))

;; Wait for a DOM event on a target.
;; (hs-wait-for target event-name) — suspends until event fires
(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 CSS transitions/animations to settle on an element.
(define
  hs-on
  (fn
    (target event-name handler)
    (when
      (not (nil? target))
      (let
        ((me-el (host-get (host-global "window") "__hs_current_me")))
        (let
          ((wrapped (fn (event) (when (not (and me-el (not (hs-ref-eq me-el target)) (nil? (host-get me-el "parentElement")))) (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))))))

;; ── Class manipulation ──────────────────────────────────────────

;; Toggle a single class on an element.
(define
  hs-on-every
  (fn (target event-name handler) (dom-listen target event-name handler)))

;; Toggle between two classes — exactly one is active at a time.
(define
  hs-on-intersection-attach!
  (fn
    (target margin threshold)
    (let
      ((opts (dict)))
      (when margin (dict-set! opts "rootMargin" margin))
      (when threshold (dict-set! opts "threshold" threshold))
      (let
        ((cb (fn (entries observer) (let ((entry (if (> (len entries) 0) (nth entries 0) nil))) (when entry (let ((intersecting (host-get entry "isIntersecting"))) (dom-dispatch target "intersection" (dict "intersecting" intersecting "entry" entry))))))))
        (let
          ((observer (host-new "IntersectionObserver" cb opts)))
          (host-call observer "observe" target)
          observer)))))

;; Take a class from siblings — add to target, remove from others.
;; (hs-take! target cls) — like radio button class behavior
(define
  hs-on-mutation-attach!
  (fn
    (target mode attr-list)
    (let
      ((cfg-attributes (or (= mode "any") (= mode "attributes") (= mode "attrs")))
        (cfg-childList (or (= mode "any") (= mode "childList")))
        (cfg-characterData (or (= mode "any") (= mode "characterData"))))
      (let
        ((opts (dict "attributes" cfg-attributes "childList" cfg-childList "characterData" cfg-characterData "subtree" true)))
        (when
          (and (= mode "attrs") attr-list)
          (dict-set! opts "attributeFilter" attr-list))
        (let
          ((cb (fn (records observer) (dom-dispatch target "mutation" (dict "records" records)))))
          (let
            ((observer (host-new "MutationObserver" cb)))
            (host-call observer "observe" target opts)
            observer))))))

;; ── DOM insertion ───────────────────────────────────────────────

;; Put content at a position relative to a target.
;; pos: "into" | "before" | "after"
(define hs-init (fn (thunk) (thunk)))

;; ── Navigation / traversal ──────────────────────────────────────

;; Navigate to a URL.
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))

;; Find next sibling matching a selector (or any sibling).
(begin
  (define
    hs-wait-for
    (fn
      (target event-name)
      (perform (list (quote io-wait-event) target event-name))))
  (define
    hs-wait-for-or
    (fn
      (target event-name timeout-ms)
      (perform (list (quote io-wait-event) target event-name timeout-ms)))))

;; Find previous sibling matching a selector.
(define
  hs-settle
  (fn
    (target)
    (hs-null-raise! target)
    (when (not (nil? target)) (perform (list (quote io-settle) target)))))

;; First element matching selector within a scope.
(define
  hs-toggle-class!
  (fn
    (target cls)
    (hs-null-raise! target)
    (when
      (not (nil? target))
      (host-call (host-get target "classList") "toggle" cls))))

;; Last element matching selector.
(define
  hs-toggle-var-cycle!
  (fn
    (win var-name values)
    (let
      ((current (host-get win var-name)) (n (len values)))
      (define
        find-idx
        (fn
          (i)
          (if
            (>= i n)
            -1
            (if (= (nth values i) current) i (find-idx (+ i 1))))))
      (let
        ((idx (find-idx 0)))
        (host-set!
          win
          var-name
          (if (= idx -1) (first values) (nth values (mod (+ idx 1) n))))))))

;; First/last within a specific scope.
(define
  hs-toggle-between!
  (fn
    (target cls1 cls2)
    (hs-null-raise! target)
    (when
      (not (nil? target))
      (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))))))

(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 (if (= prop "opacity") "1" "block"))
            (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 "")))))))

;; ── Iteration ───────────────────────────────────────────────────

;; Repeat a thunk N times.
(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)))))

;; Repeat forever (until break — relies on exception/continuation).
(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)))))

;; ── Fetch ───────────────────────────────────────────────────────

;; Fetch a URL, parse response according to format.
;; (hs-fetch url format) — format is "json" | "text" | "html"
(define
  hs-take!
  (fn
    (target kind name scope &rest extra)
    (let
      ((els (if scope (if (list? scope) scope (list scope)) (let ((parent (dom-parent target))) (if parent (dom-child-list parent) (list))))))
      (if
        (= kind "class")
        (let
          ((with-cls (if (> (len extra) 1) (nth extra 1) nil)))
          (do
            (for-each
              (fn
                (el)
                (do
                  (dom-remove-class el name)
                  (when with-cls (dom-add-class el with-cls))))
              els)
            (dom-add-class target name)
            (when with-cls (dom-remove-class target with-cls))))
        (let
          ((attr-val (if (> (len extra) 0) (first extra) nil))
            (with-val (if (> (len extra) 1) (nth extra 1) nil)))
          (do
            (for-each
              (fn
                (el)
                (when
                  (not (= el target))
                  (if
                    with-val
                    (dom-set-attr el name with-val)
                    (dom-remove-attr el name))))
              els)
            (if
              attr-val
              (dom-set-attr target name attr-val)
              (dom-set-attr target name ""))))))))

;; ── Type coercion ───────────────────────────────────────────────

;; Coerce a value to a type by name.
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
(begin
  (define
    hs-element?
    (fn
      (v)
      (and v (or (host-get v "nodeType") (host-get v "__mock_type")))))
  (define
    hs-set-attr!
    (fn
      (el name val)
      (hs-null-raise! el)
      (when
        (not (nil? el))
        (if (nil? val) (dom-remove-attr el name) (dom-set-attr el name val)))))
  (define
    hs-toggle-attr!
    (fn
      (el name)
      (hs-null-raise! el)
      (when
        (not (nil? el))
        (if
          (dom-has-attr? el name)
          (dom-remove-attr el name)
          (dom-set-attr el name "")))))
  (define
    hs-toggle-attr-val!
    (fn
      (el name val)
      (if
        (= (dom-get-attr el name) val)
        (dom-remove-attr el name)
        (dom-set-attr el name val))))
  (define
    hs-toggle-attr-between!
    (fn
      (el name val1 val2)
      (if
        (= (dom-get-attr el name) val1)
        (dom-set-attr el name val2)
        (dom-set-attr el name val1))))
  (define
    hs-toggle-attr-diff!
    (fn
      (el n1 v1 n2 v2)
      (if
        (dom-has-attr? el n1)
        (do (dom-remove-attr el n1) (dom-set-attr el n2 v2))
        (do
          (when (dom-has-attr? el n2) (dom-remove-attr el n2))
          (dom-set-attr el n1 v1)))))
  (define
    hs-set-inner-html!
    (fn
      (target value)
      (do
        (hs-null-raise! target)
        (when
          (not (nil? target))
          (let
            ((str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) (if (= value nil) "null" (str 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)))))))))
  (define
    hs-put!
    (fn
      (value pos target)
      (do
        (hs-null-raise! target)
        (when
          (not (nil? target))
          (cond
            ((= pos "innerHTML")
              (cond
                ((list? value) target)
                ((hs-element? value)
                  (do
                    (dom-set-inner-html target "")
                    (host-call target "appendChild" value)))
                (true
                  (do
                    (dom-set-inner-html target value)
                    (hs-boot-subtree! target)))))
            ((or (= pos "beforebegin") (= pos "before"))
              (if
                (hs-element? value)
                (let
                  ((parent (host-get target "parentNode")))
                  (when parent (host-call parent "insertBefore" value target)))
                (let
                  ((parent (host-get target "parentNode")))
                  (do
                    (dom-insert-adjacent-html target "beforebegin" value)
                    (when parent (hs-boot-subtree! parent))))))
            ((or (= pos "afterend") (= pos "after"))
              (if
                (hs-element? value)
                (let
                  ((parent (host-get target "parentNode"))
                    (next (host-get target "nextSibling")))
                  (when
                    parent
                    (if
                      next
                      (host-call parent "insertBefore" value next)
                      (host-call parent "appendChild" value))))
                (let
                  ((parent (host-get target "parentNode")))
                  (do
                    (dom-insert-adjacent-html target "afterend" value)
                    (when parent (hs-boot-subtree! parent))))))
            ((or (= pos "afterbegin") (= pos "start"))
              (cond
                ((list? value) (append! target value 0))
                ((hs-element? value) (dom-prepend target value))
                (true
                  (do
                    (dom-insert-adjacent-html target "afterbegin" value)
                    (hs-boot-subtree! target)))))
            ((or (= pos "beforeend") (= pos "end"))
              (cond
                ((list? value) (append! target value))
                ((hs-element? value) (dom-append target value))
                (true
                  (do
                    (dom-insert-adjacent-html target "beforeend" value)
                    (hs-boot-subtree! target)))))))))))

;; ── Object creation ─────────────────────────────────────────────

;; Make a new object of a given type.
;; (hs-make type-name) — creates empty object/collection
(define
  hs-add-to!
  (fn
    (value target)
    (cond
      ((list? target)
        (if
          (some (fn (x) (= x value)) target)
          target
          (append target (list value))))
      ((hs-is-set? target) (do (host-call target "add" value) target))
      (true (do (host-call target "push" value) target)))))

;; ── 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-remove-from!
  (fn
    (value target)
    (cond
      ((list? target) (filter (fn (x) (not (= x value))) target))
      ((hs-is-set? target) (do (host-call target "delete" value) target))
      (true (host-call target "splice" (host-call target "indexOf" value) 1)))))

;; ── 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-splice-at!
  (fn
    (target idx)
    (if
      (list? target)
      (let
        ((n (len target)))
        (let
          ((i (if (< idx 0) (+ n idx) idx)))
          (cond
            ((or (< i 0) (>= i n)) target)
            (true (concat (slice target 0 i) (slice target (+ i 1) n))))))
      (do
        (when
          target
          (let
            ((n (host-get target "length")))
            (let
              ((i (if (< idx 0) (+ (if (nil? n) 0 n) idx) idx)))
              (host-call target "splice" i 1))))
        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.
(define
  hs-index
  (fn
    (obj key)
    (cond
      ((nil? obj) nil)
      ((dict? obj) (get obj key))
      ((list? obj) (nth obj key))
      ((string? obj) (nth obj key))
      (true (host-get obj key)))))


;; ── Transition ──────────────────────────────────────────────────

;; Transition a CSS property to a value, optionally with duration.
;; (hs-transition target prop value duration)
(define
  hs-put-at!
  (fn
    (value pos target)
    (cond
      ((nil? target) (list value))
      ((list? target)
        (if
          (= pos "start")
          (cons value target)
          (append target (list value))))
      (true
        (cond
          ((hs-element? target) (do (hs-put! value pos target) target))
          (true
            (do
              (cond
                ((= pos "end") (host-call target "push" value))
                ((= pos "start") (host-call target "unshift" value)))
              target)))))))

(define
  hs-dict-without
  (fn
    (obj key)
    (cond
      ((nil? obj) (dict))
      ((dict? obj)
        (let
          ((out (dict)))
          (for-each
            (fn (k) (when (not (= k key)) (dict-set! out k (get obj k))))
            (keys obj))
          out))
      (true
        (let
          ((out (dict)))
          (host-call (host-global "Object") "assign" out obj)
          (host-call (host-global "Reflect") "deleteProperty" out key)
          out)))))

(define
  hs-set-on!
  (fn
    (props target)
    (for-each (fn (k) (host-set! target k (get props k))) (keys props))))

(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))

(define
  hs-ask
  (fn
    (msg)
    (let
      ((w (host-global "window")))
      (if w (host-call w "prompt" msg) nil))))


;; ── Transition ──────────────────────────────────────────────────

;; Transition a CSS property to a value, optionally with duration.
;; (hs-transition target prop value duration)
(define
  hs-answer
  (fn
    (msg yes-val no-val)
    (let
      ((w (host-global "window")))
      (if w (if (host-call w "confirm" msg) yes-val no-val) no-val))))

(define
  hs-answer-alert
  (fn
    (msg)
    (let
      ((w (host-global "window")))
      (if w (begin (host-call w "alert" msg) nil) nil))))

(define
  hs-scroll!
  (fn
    (target position)
    (host-call
      target
      "scrollIntoView"
      (list
        (cond
          ((= position "bottom") (dict :block "end"))
          (true (dict :block "start")))))))

(define
  hs-halt!
  (fn
    (ev mode)
    (do
      (when
        ev
        (cond
          ((= mode "default") (host-call ev "preventDefault"))
          ((= mode "bubbling") (host-call ev "stopPropagation"))
          ((= mode "the-event")
            (do
              (host-call ev "preventDefault")
              (host-call ev "stopPropagation")))
          (true
            (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))))))

(define hs-select! (fn (target) (host-call target "select" (list))))

(define
  hs-get-selection
  (fn
    ()
    (let
      ((win (host-global "window")))
      (let
        ((stash (host-get win "__test_selection")))
        (if
          (nil? stash)
          (let
            ((sel (host-call win "getSelection" (list))))
            (if (nil? sel) "" (host-call sel "toString" (list))))
          stash)))))





(define
  hs-reset!
  (fn
    (target)
    (cond
      ((list? target) (for-each (fn (el) (hs-reset! el)) target))
      ((nil? target) nil)
      (true
        (let
          ((tag (dom-get-prop target "tagName")))
          (cond
            ((= tag "FORM") (host-call target "reset" (list)))
            ((or (= tag "INPUT") (= tag "TEXTAREA"))
              (let
                ((input-type (dom-get-prop target "type")))
                (cond
                  ((or (= input-type "checkbox") (= input-type "radio"))
                    (dom-set-prop
                      target
                      "checked"
                      (dom-get-prop target "defaultChecked")))
                  (true
                    (dom-set-prop
                      target
                      "value"
                      (dom-get-prop target "defaultValue"))))))
            ((= tag "SELECT")
              (let
                ((options (host-call target "querySelectorAll" "option"))
                  (default-val nil))
                (do
                  (for-each
                    (fn
                      (opt)
                      (when
                        (and
                          (nil? default-val)
                          (dom-get-prop opt "defaultSelected"))
                        (set! default-val (dom-get-prop opt "value"))))
                    options)
                  (when
                    (and (nil? default-val) (> (len options) 0))
                    (set! default-val (dom-get-prop (first options) "value")))
                  (when default-val (dom-set-prop target "value" default-val)))))
            (true nil)))))))

(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)))))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
(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)))))
;; DOM query stub — sandbox returns empty list
(define _hs-last-query-sel nil)
;; Method dispatch — obj.method(args)
(define
  hs-null-raise!
  (fn
    (v)
    (when
      (nil? v)
      (let
        ((msg (str "'" (or (host-get (host-global "window") "_hs_last_query_sel") "target") "' is null")))
        (host-set! (host-global "window") "_hs_null_error" msg)
        (guard (_null-e (true nil)) (raise msg))))))

;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
(define
  hs-empty-raise!
  (fn
    (v)
    (when
      (or
        (nil? v)
        (and (list? v) (= (len v) 0))
        (= (host-get v "length") 0))
      (let
        ((msg (str "'" (or (host-get (host-global "window") "_hs_last_query_sel") "target") "' is null")))
        (host-set! (host-global "window") "_hs_null_error" msg)
        (guard (_null-e (true nil)) (raise msg))))))
;; Property-based is — check obj.key truthiness
(define
  hs-query-all-checked
  (fn
    (sel)
    (let
      ((result (hs-query-all sel)))
      (do (hs-empty-raise! result) result))))
;; Array slicing (inclusive both ends)
(define
  hs-dispatch!
  (fn
    (target event detail)
    (hs-null-raise! target)
    (when (not (nil? target)) (dom-dispatch target event detail))))
;; Collection: sorted by
(define
  hs-query-all
  (fn
    (sel)
    (do
      (host-set! (host-global "window") "_hs_last_query_sel" sel)
      (dom-query-all (dom-document) sel))))
;; Collection: sorted by descending
(define
  hs-query-all-in
  (fn
    (sel target)
    (if
      (nil? target)
      (hs-query-all sel)
      (host-call target "querySelectorAll" sel))))
;; Collection: split by
(define
  hs-list-set
  (fn
    (lst idx val)
    (append (take lst idx) (cons val (drop lst (+ idx 1))))))
;; Collection: joined by
(define
  hs-to-number
  (fn (v) (if (number? v) v (or (parse-number (str v)) 0))))

(define
  hs-query-first
  (fn
    (sel)
    (do
      (host-set! (host-global "window") "_hs_last_query_sel" sel)
      (host-call (host-global "document") "querySelector" sel))))

(define
  hs-query-last
  (fn
    (sel)
    (let
      ((all (dom-query-all (dom-body) sel)))
      (if (> (len all) 0) (nth all (- (len all) 1)) nil))))

(define hs-first (fn (scope sel) (dom-query-all scope sel)))

(define
  hs-last
  (fn
    (scope sel)
    (let
      ((all (dom-query-all scope sel)))
      (if (> (len all) 0) (nth all (- (len all) 1)) nil))))

(define
  hs-repeat-times
  (fn
    (n thunk)
    (define
      do-repeat
      (fn
        (i)
        (when
          (< i n)
          (let
            ((ex nil) (raised false))
            (do
              (guard
                (e (true (do (set! ex e) (set! raised true) nil)))
                (do (thunk) nil))
              (cond
                ((not raised) (do-repeat (+ i 1)))
                ((= (str ex) "hs-break") nil)
                ((= (str ex) "hs-continue") (do-repeat (+ i 1)))
                (true (raise ex))))))))
    (do-repeat 0)))

(define
  hs-repeat-forever
  (fn
    (thunk)
    (define
      do-forever
      (fn
        ()
        (let
          ((ex nil) (raised false))
          (do
            (guard
              (e (true (do (set! ex e) (set! raised true) nil)))
              (do (thunk) nil))
            (cond
              ((not raised) (do-forever))
              ((= (str ex) "hs-break") nil)
              ((= (str ex) "hs-continue") (do-forever))
              (true (raise ex)))))))
    (do-forever)))

(define
  hs-repeat-while
  (fn
    (cond-fn thunk)
    (when
      (cond-fn)
      (let
        ((ex nil) (raised false))
        (do
          (guard
            (e (true (do (set! ex e) (set! raised true) nil)))
            (do (thunk) nil))
          (cond
            ((not raised) (hs-repeat-while cond-fn thunk))
            ((= (str ex) "hs-break") nil)
            ((= (str ex) "hs-continue") (hs-repeat-while cond-fn thunk))
            (true (raise ex))))))))

(define
  hs-repeat-until
  (fn
    (cond-fn thunk)
    (let
      ((ex nil) (raised false))
      (do
        (guard
          (e (true (do (set! ex e) (set! raised true) nil)))
          (do (thunk) nil))
        (cond
          ((not raised) (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
          ((= (str ex) "hs-break") nil)
          ((= (str ex) "hs-continue")
            (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
          (true (raise ex)))))))

(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)))))
      (define
        do-loop
        (fn
          (remaining)
          (when
            (not (empty? remaining))
            (let
              ((ex nil) (raised false))
              (do
                (guard
                  (e (true (do (set! ex e) (set! raised true) nil)))
                  (do (fn-body (first remaining)) nil))
                (cond
                  ((not raised) (do-loop (rest remaining)))
                  ((= (str ex) "hs-break") nil)
                  ((= (str ex) "hs-continue") (do-loop (rest remaining)))
                  (true (raise ex))))))))
      (do-loop items))))
;; Collection: joined by
(begin
  (define
    hs-append
    (fn
      (target value)
      (cond
        ((nil? target) value)
        ((string? target) (str target value))
        ((list? target)
          (if
            (some (fn (x) (= x value)) target)
            target
            (append target (list value))))
        ((hs-is-set? target) (do (host-call target "add" value) target))
        ((hs-element? target)
          (do
            (dom-insert-adjacent-html
              target
              "beforeend"
              (if
                (hs-element? value)
                (host-get value "outerHTML")
                (str value)))
            target))
        (true (str target value)))))
  (define
    hs-append!
    (fn
      (value target)
      (cond
        ((nil? target) nil)
        ((hs-element? target)
          (dom-insert-adjacent-html
            target
            "beforeend"
            (if
              (hs-element? value)
              (host-get value "outerHTML")
              (str value))))
        (true nil)))))

(define
  hs-sender
  (fn
    (event)
    (let
      ((detail (host-get event "detail")))
      (if detail (get detail "sender") nil))))

(define
  hs-host-to-sx
  (fn
    (v)
    (cond
      ((nil? v) v)
      ((number? v) v)
      ((string? v) v)
      ((boolean? v) v)
      (true
        (let
          ((marker (host-get v "_type")))
          (cond
            ((= marker "dict")
              (let
                ((out (dict)))
                (begin
                  (for-each
                    (fn (k) (dict-set! out k (hs-host-to-sx (get v k))))
                    (keys v))
                  out)))
            ((= marker "list") (map hs-host-to-sx v))
            (true
              (let
                ((is-array (host-call (host-global "Array") "isArray" v)))
                (if
                  is-array
                  (let
                    ((len (host-get v "length")) (out (list)))
                    (begin
                      (let
                        ((i 0))
                        (for-each
                          (fn
                            (_)
                            (begin
                              (set!
                                out
                                (append
                                  out
                                  (list (hs-host-to-sx (host-get v i)))))
                              (set! i (+ i 1))))
                          (range 0 len)))
                      out))
                  (let
                    ((out (dict)))
                    (begin
                      (for-each
                        (fn
                          (k)
                          (dict-set! out k (hs-host-to-sx (host-get v k))))
                        (host-call (host-global "Object") "keys" v))
                      out)))))))))))

(define
  hs-fetch-impl
  (fn
    (url format no-throw)
    (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})))
      (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))))
            ((= fmt "html") (perform (list "io-parse-html" 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)))

(define
  hs-json-escape
  (fn
    (s)
    (str
      "\""
      (let
        ((out "") (i 0) (n (string-length s)))
        (define
          walk
          (fn
            ()
            (when
              (< i n)
              (let
                ((c (substring s i (+ i 1))))
                (set!
                  out
                  (cond
                    ((= c "\\") (str out "\\\\"))
                    ((= c "\"") (str out "\\\""))
                    ((= c "\n") (str out "\\n"))
                    ((= c "\r") (str out "\\r"))
                    ((= c "\t") (str out "\\t"))
                    (true (str out c))))
                (set! i (+ i 1))
                (walk)))))
        (walk)
        out)
      "\"")))

(define
  hs-json-stringify
  (fn
    (v)
    (cond
      ((nil? v) "null")
      ((= v true) "true")
      ((= v false) "false")
      ((number? v) (str v))
      ((string? v) (hs-json-escape v))
      ((list? v) (str "[" (join "," (map hs-json-stringify v)) "]"))
      ((dict? v)
        (let
          ((ks (or (get v "_order") (filter (fn (k) (not (= k "_order"))) (keys v)))))
          (str
            "{"
            (join
              ","
              (filter
                (fn (s) (not (= s "")))
                (map
                  (fn
                    (k)
                    (if
                      (= k "_order")
                      ""
                      (str
                        (hs-json-escape k)
                        ":"
                        (hs-json-stringify (get v k)))))
                  ks)))
            "}")))
      (true (hs-json-escape (str v))))))

(begin
  (define _hs-custom-conversions {})
  (define _hs-dynamic-converters (list))
  (define
    hs-set-conversion!
    (fn (name conv-fn) (dict-set! _hs-custom-conversions name conv-fn)))
  (define
    hs-clear-conversion!
    (fn (name) (dict-set! _hs-custom-conversions name nil)))
  (define
    hs-add-dynamic-converter!
    (fn
      (conv-fn)
      (set!
        _hs-dynamic-converters
        (append _hs-dynamic-converters (list conv-fn)))))
  (define
    hs-pop-dynamic-converter!
    (fn
      ()
      (let
        ((n (len _hs-dynamic-converters)))
        (when
          (> n 0)
          (set!
            _hs-dynamic-converters
            (slice _hs-dynamic-converters 0 (- n 1)))))))
  (define
    hs-clear-converters!
    (fn
      ()
      (do
        (set! _hs-custom-conversions {})
        (set! _hs-dynamic-converters (list))))))

(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")
        (if
          (list? value)
          (join "," (map (fn (x) (str x)) value))
          (str value)))
      ((= type-name "Bool") (not (hs-falsy? value)))
      ((= type-name "Boolean") (not (hs-falsy? value)))
      ((= type-name "Array") (if (list? value) value (list value)))
      ((= type-name "HTML")
        (cond
          ((list? value)
            (join
              ""
              (map
                (fn
                  (x)
                  (if (hs-element? x) (host-get x "outerHTML") (str x)))
                value)))
          ((hs-element? value) (host-get value "outerHTML"))
          (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)
          (true value)))
      ((= type-name "Object")
        (if
          (string? value)
          (guard (_e (true value)) (json-parse value))
          value))
      ((= type-name "JSONString") (hs-json-stringify value))
      ((= type-name "FormEncoded")
        (if
          (dict? value)
          (let
            ((ks (or (get value "_order") (filter (fn (k) (not (= k "_order"))) (keys value)))))
            (join
              "&"
              (filter
                (fn (s) (not (= s "")))
                (map
                  (fn
                    (k)
                    (if
                      (= k "_order")
                      ""
                      (let
                        ((v (get value k)))
                        (if
                          (list? v)
                          (join "&" (map (fn (item) (str k "=" item)) v))
                          (str k "=" v)))))
                  ks))))
          (str value)))
      ((or (= type-name "Fixed") (= type-name "Fixed:") (starts-with? type-name "Fixed:"))
        (let
          ((digits (if (> (string-length type-name) 6) (+ (substring type-name 6 (string-length type-name)) 0) 0))
            (num (+ value 0)))
          (if
            (= digits 0)
            (str (floor num))
            (let
              ((factor (pow 10 digits)))
              (str (/ (floor (+ (* num factor) 0.5)) factor))))))
      ((= type-name "Selector") (str value))
      ((= type-name "Fragment")
        (let
          ((frag (host-call (dom-document) "createDocumentFragment")))
          (do
            (for-each
              (fn
                (item)
                (if
                  (hs-element? item)
                  (dom-append frag item)
                  (let
                    ((tmp (dom-create-element "div")))
                    (do
                      (dom-set-inner-html tmp (str item))
                      (for-each
                        (fn (k) (dom-append frag k))
                        (host-get tmp "children"))))))
              (if (list? value) value (list value)))
            frag)))
      ((= type-name "Values") (hs-as-values value))
      ((= type-name "Keys")
        (if
          (dict? value)
          (sort (filter (fn (k) (not (= k "_order"))) (keys value)))
          value))
      ((= type-name "Entries")
        (if
          (dict? value)
          (let
            ((ks (if (dict-has? value "_order") (get value "_order") (filter (fn (k) (not (= k "_order"))) (keys value)))))
            (map (fn (k) (list k (get value k))) ks))
          value))
      ((= type-name "Reversed") (if (list? value) (reverse value) value))
      ((= type-name "Unique")
        (if
          (list? value)
          (reduce
            (fn
              (acc x)
              (if (some (fn (a) (= a x)) acc) acc (append acc (list x))))
            (list)
            value)
          value))
      ((or (= type-name "Flattened") (= type-name "Flat"))
        (if
          (list? value)
          (reduce
            (fn
              (acc x)
              (if (list? x) (append acc x) (append acc (list x))))
            (list)
            value)
          value))
      ((= type-name "Set")
        (let
          ((s (host-new "Set")))
          (do
            (when
              (list? value)
              (for-each (fn (x) (host-call s "add" x)) value))
            s)))
      ((= type-name "Map")
        (let
          ((m (host-new "Map")))
          (do
            (when
              (dict? value)
              (for-each
                (fn (k) (host-call m "set" k (get value k)))
                (filter (fn (k) (not (= k "_order"))) (keys value))))
            m)))
      ((= type-name "Date") (host-new "Date" value))
      (true
        (let
          ((static-fn (get _hs-custom-conversions type-name)))
          (if
            (not (nil? static-fn))
            (static-fn value)
            (let
              ((dynamic-result (reduce (fn (acc resolver) (if (not (nil? acc)) acc (resolver type-name value))) nil _hs-dynamic-converters)))
              (if (not (nil? dynamic-result)) dynamic-result value))))))))

(define
  hs-gather-form-nodes
  (fn
    (root)
    (let
      ((acc (list)))
      (define
        walk
        (fn
          (node)
          (let
            ((tag (host-get node "tagName")))
            (cond
              ((or (= tag "INPUT") (= tag "SELECT") (= tag "TEXTAREA"))
                (set! acc (append acc (list node))))
              (true
                (let
                  ((kids (host-get node "children")))
                  (when
                    (not (nil? kids))
                    (cond
                      ((list? kids)
                        (let
                          ((n (len kids)))
                          (define
                            each
                            (fn
                              (i)
                              (when
                                (< i n)
                                (walk (nth kids i))
                                (each (+ i 1)))))
                          (each 0)))
                      (true
                        (let
                          ((n (or (host-get kids "length") 0)))
                          (define
                            each-h
                            (fn
                              (i)
                              (when
                                (< i n)
                                (walk (host-get kids i))
                                (each-h (+ i 1)))))
                          (each-h 0)))))))))))
      (walk root)
      acc)))

(define
  hs-values-from-nodes
  (fn (nodes) (reduce hs-values-absorb (dict) nodes)))

(define
  hs-value-of-node
  (fn
    (node)
    (let
      ((tag (host-get node "tagName")) (typ (host-get node "type")))
      (cond
        ((= tag "SELECT")
          (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")
                  "")))))
        ((or (= typ "checkbox") (= typ "radio"))
          (if (host-get node "checked") (host-get node "value") nil))
        (true (host-get node "value"))))))

(define
  hs-select-multi-values
  (fn
    (node)
    (let
      ((options (host-get node "options")) (acc (list)))
      (if
        (or (nil? options) (not (list? options)))
        acc
        (let
          ((n (len options)))
          (define
            each
            (fn
              (i)
              (when
                (< i n)
                (let
                  ((opt (nth options i)))
                  (when
                    (host-get opt "selected")
                    (set! acc (append acc (list (host-get opt "value"))))))
                (each (+ i 1)))))
          (each 0)
          acc)))))

(define
  hs-values-absorb
  (fn
    (acc node)
    (let
      ((name (host-get node "name")))
      (if
        (or (nil? name) (= name ""))
        acc
        (let
          ((v (hs-value-of-node node)))
          (cond
            ((nil? v) acc)
            ((has-key? acc name)
              (let
                ((existing (get acc name)))
                (do
                  (if
                    (list? existing)
                    (dict-set! acc name (append existing (list v)))
                    (dict-set! acc name (list existing v)))
                  acc)))
            (true
              (begin
                (dict-set! acc name v)
                (let
                  ((ord (or (get acc "_order") (list))))
                  (when
                    (not (some (fn (x) (= x name)) ord))
                    (dict-set! acc "_order" (append ord (list name)))))
                acc))))))))

(define
  hs-as-values
  (fn
    (value)
    (cond
      ((nil? value) (dict))
      ((list? value) (hs-values-from-nodes value))
      (true
        (let
          ((tag (host-get value "tagName")))
          (cond
            ((or (= tag "INPUT") (= tag "SELECT") (= tag "TEXTAREA"))
              (hs-values-from-nodes (list value)))
            (true (hs-values-from-nodes (hs-gather-form-nodes value)))))))))

(define
  hs-default?
  (fn
    (v)
    (cond
      ((nil? v) true)
      ((and (string? v) (= v "")) true)
      (true false))))

(define
  hs-array-set!
  (fn
    (arr i v)
    (if (list? arr) (do (set-nth! arr i v) v) (host-set! arr i v))))

(define
  hs-add
  (fn
    (a b)
    (cond
      ((list? a) (if (list? b) (append a b) (append a (list b))))
      ((list? b) (cons a b))
      ((or (string? a) (string? b)) (str a b))
      (true (+ a b)))))

(begin
  (define
    hs-make
    (fn
      (type-name &rest args)
      (if
        (hs-make-element? type-name)
        (hs-make-element type-name)
        (let
          ((ctor (host-global type-name)))
          (if
            (nil? ctor)
            (cond
              ((= type-name "Object") (dict))
              ((= type-name "Array") (list))
              ((= type-name "Set") (host-new "Set"))
              ((= type-name "Map") (host-new "Map"))
              (true (dict)))
            (apply host-new (cons type-name args)))))))
  (define
    hs-make-element?
    (fn
      (s)
      (and
        (string? s)
        (> (len s) 0)
        (let
          ((c (substring s 0 1)))
          (or
            (= c ".")
            (= c "#")
            (contains? s ".")
            (contains? s "#")
            (and (hs-lower-letter? c) (not (any-upper? s))))))))
  (define hs-lower-letter? (fn (c) (and (>= c "a") (<= c "z"))))
  (define
    any-upper?
    (fn
      (s)
      (let
        ((n (len s)))
        (define
          scan
          (fn
            (i)
            (cond
              ((>= i n) false)
              ((and (>= (substring s i (+ i 1)) "A") (<= (substring s i (+ i 1)) "Z"))
                true)
              (true (scan (+ i 1))))))
        (scan 0))))
  (define
    hs-make-element
    (fn
      (sel)
      (let
        ((parsed (hs-parse-element-selector sel)))
        (let
          ((tag (get parsed "tag"))
            (id (get parsed "id"))
            (classes (get parsed "classes")))
          (let
            ((el (dom-create-element (if (= tag "") "div" tag))))
            (when (and id (not (= id ""))) (dom-set-attr el "id" id))
            (for-each (fn (c) (dom-add-class el c)) classes)
            el)))))
  (define
    hs-parse-element-selector
    (fn
      (sel)
      (let
        ((n (len sel))
          (tag "")
          (id "")
          (classes (list))
          (cur "")
          (mode "tag"))
        (define
          flush!
          (fn
            ()
            (cond
              ((= mode "tag") (set! tag cur))
              ((= mode "id") (set! id cur))
              ((= mode "class") (set! classes (append classes (list cur)))))
            (set! cur "")))
        (define
          walk
          (fn
            (i)
            (when
              (< i n)
              (let
                ((ch (substring sel i (+ i 1))))
                (cond
                  ((= ch ".")
                    (do (flush!) (set! mode "class") (walk (+ i 1))))
                  ((= ch "#")
                    (do (flush!) (set! mode "id") (walk (+ i 1))))
                  (true (do (set! cur (str cur ch)) (walk (+ i 1)))))))))
        (walk 0)
        (flush!)
        {:tag tag :classes classes :id id}))))

(define hs-install (fn (behavior-fn) (behavior-fn me)))

(define
  hs-measure
  (fn
    (target)
    (hs-null-raise! target)
    (when (not (nil? target)) (perform (list (quote io-measure) target)))))

(define
  hs-transition
  (fn
    (target prop value duration)
    (hs-null-raise! target)
    (when
      (not (nil? target))
      (let
        ((init-attr (str "data-hs-transition-" 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)))))))

(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))))

(begin
  (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))
          ((= type-name "Element") (= (host-typeof value) "element"))
          ((= type-name "Node")
            (or
              (= (host-typeof value) "element")
              (= (host-typeof value) "text")))
          (true (= (host-typeof value) (downcase type-name)))))))
  (define
    hs-type-assert
    (fn
      (value type-name)
      (if
        (hs-type-check value type-name)
        value
        (raise (str "Typecheck failed! expected " type-name)))))
  (define
    hs-type-assert-strict
    (fn
      (value type-name)
      (if
        (nil? value)
        (raise (str "Typecheck failed! expected " type-name " but got nil"))
        (hs-type-assert value type-name)))))

(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))))

(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)))))

(define
  hs-starts-with?
  (fn
    (s prefix)
    (cond
      ((nil? s) false)
      ((nil? prefix) false)
      (true (starts-with? (str s) (str prefix))))))

(define
  hs-ends-with?
  (fn
    (s suffix)
    (cond
      ((nil? s) false)
      ((nil? suffix) false)
      (true (ends-with? (str s) (str suffix))))))

(define
  hs-attr-watch!
  (fn
    (target attr-name handler)
    (let
      ((mo-class (host-get (host-global "window") "MutationObserver")))
      (when
        mo-class
        (let
          ((cb (fn (records observer) (for-each (fn (rec) (when (= (host-get rec "attributeName") attr-name) (handler (host-call target "getAttribute" attr-name)))) records))))
          (let
            ((mo (host-new "MutationObserver" cb)))
            (host-call mo "observe" target {:attributeFilter (list attr-name) :attributes true})))))))

(define
  hs-scoped-set!
  (fn
    (el name val)
    (let
      ((changed (not (= (hs-scoped-get el name) val))))
      (do
        (dom-set-data el (str "hs-local-" name) val)
        (when changed (hs-scoped-fire-watchers! el name val))))))

(begin
  (define _hs-scoped-watchers (list))
  (define
    hs-scoped-watch!
    (fn
      (el name handler)
      (set!
        _hs-scoped-watchers
        (cons (list el name handler) _hs-scoped-watchers))))
  (define
    hs-scoped-fire-watchers!
    (fn
      (el name val)
      (for-each
        (fn
          (entry)
          (when
            (and (= (nth entry 0) el) (= (nth entry 1) name))
            ((nth entry 2) val)))
        _hs-scoped-watchers))))

(define
  hs-scoped-get
  (fn (el name) (dom-get-data el (str "hs-local-" name))))

(define
  hs-precedes?
  (fn
    (a b)
    (cond
      ((nil? a) false)
      ((nil? b) false)
      ((and (dict? a) (dict? b))
        (let
          ((pos (host-call a "compareDocumentPosition" b)))
          (if (number? pos) (not (= 0 (mod (/ pos 4) 2))) false)))
      (true (< (str a) (str b))))))

(define
  hs-follows?
  (fn
    (a b)
    (cond ((nil? a) false) ((nil? b) false) (true (> (str a) (str b))))))

(define
  hs-starts-with-ic?
  (fn (str prefix) (starts-with? (downcase str) (downcase prefix))))

(define
  hs-ends-with-ic?
  (fn (str suffix) (ends-with? (downcase str) (downcase suffix))))

(define
  hs-matches-ignore-case?
  (fn
    (target pattern)
    (cond
      ((string? target)
        (contains? (downcase (str target)) (downcase (str pattern))))
      (true false))))

(define
  hs-contains-ignore-case?
  (fn
    (haystack needle)
    (contains? (downcase (str haystack)) (downcase (str needle)))))

(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))))

(define
  hs-matches?
  (fn
    (target pattern)
    (cond
      ((string? target)
        (if (= pattern ".*") true (string-contains? target pattern)))
      ((= (host-typeof target) "element")
        (if (string? pattern) (host-call target "matches" pattern) false))
      (true false))))

(define
  hs-contains?
  (fn
    (collection item)
    (cond
      ((nil? collection) false)
      ((string? collection) (string-contains? collection (str item)))
      ((list? collection)
        (cond
          ((nil? item) (list))
          ((list? item)
            (filter (fn (x) (hs-contains? collection x)) item))
          (true
            (if
              (= (len collection) 0)
              false
              (if
                (= (first collection) item)
                true
                (hs-contains? (rest collection) item))))))
      (true false))))

(define
  hs-in?
  (fn
    (collection item)
    (cond
      ((nil? collection) (list))
      ((list? collection)
        (cond
          ((nil? item) (list))
          ((list? item)
            (filter (fn (x) (hs-contains? collection x)) item))
          ((hs-contains? collection item) (list item))
          (true (list))))
      (true (list)))))

(define
  hs-in-bool?
  (fn (collection item) (not (hs-falsy? (hs-in? collection item)))))

(define
  hs-is
  (fn
    (obj thunk prop)
    (cond
      ((and (dict? obj) (some (fn (k) (= k prop)) (keys obj)))
        (not (hs-falsy? (get obj prop))))
      (true
        (let
          ((r (cek-try thunk)))
          (if
            (and (list? r) (= (first r) (quote ok)))
            (= obj (nth r 1))
            (= obj nil)))))))

(define
  precedes?
  (fn
    (a b)
    (cond
      ((nil? a) false)
      ((nil? b) false)
      ((and (dict? a) (dict? b))
        (let
          ((pos (host-call a "compareDocumentPosition" b)))
          (if (number? pos) (not (= 0 (mod (/ pos 4) 2))) false)))
      (true (< (str a) (str b))))))

(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))))

(define
  hs-empty-like
  (fn
    (v)
    (cond
      ((list? v) (list))
      ((dict? v) (dict))
      ((hs-is-set? v) (host-new "Set"))
      ((hs-is-map? v) (host-new "Map"))
      ((string? v) "")
      ((nil? v) nil)
      (true v))))

(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")
              (let
                ((children (host-call target "querySelectorAll" "input, textarea, select")))
                (for-each (fn (el) (hs-empty-target! el)) children)))
            (true (dom-set-inner-html target ""))))))))

(define
  hs-morph-char
  (fn (s p) (if (or (< p 0) (>= p (string-length s))) nil (nth s p))))

(define
  hs-morph-index-from
  (fn
    (s needle from)
    (let
      ((r (index-of (substring s from (string-length s)) needle)))
      (if (< r 0) -1 (+ from r)))))

(define
  hs-morph-sws
  (fn
    (s p)
    (let
      ((c (hs-morph-char s p)))
      (if (and c (hs-ws? c)) (hs-morph-sws s (+ p 1)) p))))

(define
  hs-morph-read-until
  (fn
    (s p stop)
    (define
      loop
      (fn
        (q)
        (let
          ((c (hs-morph-char s q)))
          (if (and c (< (index-of stop c) 0)) (loop (+ q 1)) q))))
    (let ((e (loop p))) (list (substring s p e) e))))

(define
  hs-morph-parse-attrs
  (fn
    (s p acc)
    (let
      ((p (hs-morph-sws s p)))
      (let
        ((c (hs-morph-char s p)))
        (cond
          ((nil? c) (list acc p false))
          ((= c ">") (list acc (+ p 1) false))
          ((= c "/")
            (if
              (= (hs-morph-char s (+ p 1)) ">")
              (list acc (+ p 2) true)
              (list acc (+ p 1) false)))
          (true
            (let
              ((r (hs-morph-read-until s p " \t\n=/>")))
              (let
                ((name (first r)) (p2 (nth r 1)))
                (let
                  ((p3 (hs-morph-sws s p2)))
                  (if
                    (= (hs-morph-char s p3) "=")
                    (let
                      ((p4 (hs-morph-sws s (+ p3 1))))
                      (let
                        ((c2 (hs-morph-char s p4)))
                        (cond
                          ((= c2 "\"")
                            (let
                              ((close (hs-morph-index-from s "\"" (+ p4 1))))
                              (hs-morph-parse-attrs
                                s
                                (+ close 1)
                                (append
                                  acc
                                  (list
                                    (list name (substring s (+ p4 1) close)))))))
                          ((= c2 "'")
                            (let
                              ((close (hs-morph-index-from s "'" (+ p4 1))))
                              (hs-morph-parse-attrs
                                s
                                (+ close 1)
                                (append
                                  acc
                                  (list
                                    (list name (substring s (+ p4 1) close)))))))
                          (true
                            (let
                              ((r2 (hs-morph-read-until s p4 " \t\n/>")))
                              (hs-morph-parse-attrs
                                s
                                (nth r2 1)
                                (append acc (list (list name (first r2))))))))))
                    (hs-morph-parse-attrs
                      s
                      p3
                      (append acc (list (list name ""))))))))))))))

(define
  hs-morph-parse-element
  (fn
    (s p)
    (let
      ((p (hs-morph-sws s p)))
      (if
        (not (= (hs-morph-char s p) "<"))
        nil
        (let
          ((r (hs-morph-read-until s (+ p 1) " \t\n/>")))
          (let
            ((tag (first r)) (p2 (nth r 1)))
            (let
              ((ar (hs-morph-parse-attrs s p2 (list))))
              (let
                ((attrs (first ar))
                  (p3 (nth ar 1))
                  (self-closing (nth ar 2)))
                (if
                  self-closing
                  {:children (list) :end p3 :tag tag :type "element" :attrs attrs}
                  (let
                    ((cr (hs-morph-parse-children s p3 (list))))
                    {:children (first cr) :end (nth cr 1) :tag tag :type "element" :attrs attrs}))))))))))

(define
  hs-morph-parse-children
  (fn
    (s p acc)
    (let
      ((c (hs-morph-char s p)))
      (cond
        ((nil? c) (list acc p))
        ((= c "<")
          (if
            (= (hs-morph-char s (+ p 1)) "/")
            (let
              ((close-gt (hs-morph-index-from s ">" (+ p 1))))
              (list acc (+ close-gt 1)))
            (let
              ((child (hs-morph-parse-element s p)))
              (if
                (nil? child)
                (list acc p)
                (hs-morph-parse-children
                  s
                  (get child :end)
                  (append acc (list child)))))))
        (true
          (let
            ((r (hs-morph-read-until s p "<")))
            (hs-morph-parse-children
              s
              (nth r 1)
              (append acc (list {:text (first r) :type "text"})))))))))

(define
  hs-morph-apply-attrs
  (fn
    (el attrs keep-id)
    (for-each
      (fn
        (av)
        (let
          ((n (first av)) (v (nth av 1)))
          (cond
            ((= n "class")
              (for-each
                (fn
                  (c)
                  (when (> (string-length c) 0) (dom-add-class el c)))
                (split v " ")))
            ((and keep-id (= n "id")) nil)
            (true (dom-set-attr el n v)))))
      attrs)))

(define
  hs-morph-build-children
  (fn
    (parent children)
    (cond
      ((= (len children) 0) nil)
      ((and (= (len children) 1) (= (get (first children) :type) "text"))
        (dom-set-inner-html parent (get (first children) :text)))
      (true (for-each (fn (c) (hs-morph-build-child parent c)) children)))))

(define
  hs-morph-build-child
  (fn
    (parent node)
    (cond
      ((= (get node :type) "element")
        (let
          ((el (dom-create-element (get node :tag))))
          (do
            (hs-morph-apply-attrs el (get node :attrs) false)
            (hs-morph-build-children el (get node :children))
            (dom-append parent el)
            (hs-activate! el))))
      (true nil))))

(define
  hs-morph!
  (fn
    (target content)
    (when
      target
      (let
        ((tree (hs-morph-parse-element content 0)))
        (when
          tree
          (do
            (hs-morph-apply-attrs target (get tree :attrs) true)
            (dom-set-inner-html target "")
            (hs-morph-build-children target (get tree :children))))))))

(define
  hs-open!
  (fn
    (el)
    (let
      ((tag (dom-get-prop el "tagName")))
      (cond
        ((= tag "DIALOG") (host-call el "showModal"))
        (true
          (do (dom-set-attr el "open" "") (dom-set-prop el "open" true)))))))

(define
  hs-close!
  (fn
    (el)
    (let
      ((tag (dom-get-prop el "tagName")))
      (cond
        ((= tag "DIALOG") (host-call el "close"))
        (true
          (do
            (host-call el "removeAttribute" "open")
            (dom-set-prop el "open" false)))))))

(begin
  (define _hs-hide-strategies (dict))
  (define _hs-default-hide-strategy nil)
  (define
    hs-set-hide-strategies!
    (fn
      (strategies)
      (for-each
        (fn (k) (dict-set! _hs-hide-strategies k (get strategies k)))
        (keys strategies))))
  (define
    hs-set-default-hide-strategy!
    (fn (name) (set! _hs-default-hide-strategy name)))
  (define
    _hs-resolve-strategy
    (fn
      (strategy)
      (cond
        ((and (= strategy "display") _hs-default-hide-strategy)
          _hs-default-hide-strategy)
        (true strategy))))
  (define
    hs-hide-one!
    (fn
      (el strategy)
      (let
        ((resolved (_hs-resolve-strategy strategy)))
        (let
          ((parts (split resolved ":")))
          (let
            ((prop (first parts))
              (val (if (> (len parts) 1) (nth parts 1) nil)))
            (cond
              ((and (not (= prop "display")) (not (= prop "opacity")) (not (= prop "visibility")) (not (= prop "hidden")) (not (= prop "class-hidden")) (not (= prop "class-invisible")) (not (= prop "class-opacity")) (not (= prop "details")) (not (= prop "dialog")) (dict-has? _hs-hide-strategies prop))
                (let
                  ((fn-val (get _hs-hide-strategies prop)))
                  (fn-val "hide" el val)))
              ((= (dom-get-prop el "tagName") "DIALOG")
                (when (dom-has-attr? el "open") (host-call el "close")))
              ((= (dom-get-prop el "tagName") "DETAILS")
                (dom-set-prop el "open" false))
              ((= prop "opacity")
                (dom-set-style el "opacity" (if val val "0")))
              ((= prop "visibility")
                (dom-set-style el "visibility" (if val val "hidden")))
              ((= prop "hidden") (dom-set-attr el "hidden" ""))
              ((= prop "class-hidden") (dom-add-class el "hidden"))
              ((= prop "class-invisible") (dom-add-class el "invisible"))
              ((= prop "class-opacity") (dom-add-class el "opacity-0"))
              (true (dom-set-style el "display" (if val val "none")))))))))
  (define
    hs-hide!
    (fn
      (target strategy)
      (hs-empty-raise! target)
      (if
        (list? target)
        (do (for-each (fn (el) (hs-hide-one! el strategy)) target) target)
        (do (hs-hide-one! target strategy) target)))))

(begin
  (define
    hs-show-one!
    (fn
      (el strategy)
      (let
        ((resolved (_hs-resolve-strategy strategy)))
        (let
          ((parts (split resolved ":")))
          (let
            ((prop (first parts))
              (val (if (> (len parts) 1) (nth parts 1) nil)))
            (cond
              ((and (not (= prop "display")) (not (= prop "opacity")) (not (= prop "visibility")) (not (= prop "hidden")) (not (= prop "class-hidden")) (not (= prop "class-invisible")) (not (= prop "class-opacity")) (not (= prop "details")) (not (= prop "dialog")) (dict-has? _hs-hide-strategies prop))
                (let
                  ((fn-val (get _hs-hide-strategies prop)))
                  (fn-val "show" el val)))
              ((= (dom-get-prop el "tagName") "DIALOG")
                (when
                  (not (dom-has-attr? el "open"))
                  (host-call el "showModal")))
              ((= (dom-get-prop el "tagName") "DETAILS")
                (dom-set-prop el "open" true))
              ((= prop "opacity")
                (dom-set-style el "opacity" (if val val "1")))
              ((= prop "visibility")
                (dom-set-style el "visibility" (if val val "visible")))
              ((= prop "hidden") (dom-remove-attr el "hidden"))
              ((= prop "class-hidden") (dom-remove-class el "hidden"))
              ((= prop "class-invisible") (dom-remove-class el "invisible"))
              ((= prop "class-opacity") (dom-remove-class el "opacity-0"))
              (true (dom-set-style el "display" (if val val "block")))))))))
  (define
    hs-show!
    (fn
      (target strategy)
      (hs-empty-raise! target)
      (if
        (list? target)
        (do (for-each (fn (el) (hs-show-one! el strategy)) target) target)
        (do (hs-show-one! target strategy) target)))))

(define
  hs-show-when!
  (fn
    (target strategy pred)
    (let
      ((items (if (list? target) target (list target))))
      (let
        ((matched (list)))
        (do
          (for-each
            (fn
              (el)
              (if
                (pred el)
                (do (hs-show-one! el strategy) (append! matched el))
                (hs-hide-one! el strategy)))
            items)
          matched)))))

(define
  hs-hide-when!
  (fn
    (target strategy pred)
    (let
      ((items (if (list? target) target (list target))))
      (let
        ((matched (list)))
        (do
          (for-each
            (fn
              (el)
              (if
                (pred el)
                (do (hs-hide-one! el strategy) (append! matched el))
                (hs-show-one! el strategy)))
            items)
          matched)))))

(define hs-first (fn (lst) (first lst)))

(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)
            (let
              ((name (first pair)))
              (do
                (dict-set! d name (nth pair 1))
                (dict-set!
                  d
                  "_order"
                  (append (or (get d "_order") (list)) (list name))))))
          pairs)
        d))))

(define
  hs-strip-order-deep
  (fn
    (val)
    (cond
      ((dict? val)
        (let
          ((d (dict)))
          (do
            (for-each
              (fn
                (k)
                (when
                  (not (= k "_order"))
                  (dict-set! d k (hs-strip-order-deep (get val k)))))
              (filter (fn (k) (not (= k "_order"))) (keys val)))
            d)))
      ((list? val) (map hs-strip-order-deep val))
      (true val))))

(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
        (let
          ((fn-val (host-get obj method)))
          (cond
            ((and fn-val (callable? fn-val)) (apply fn-val args))
            (fn-val (apply host-call (cons obj (cons method args))))
            (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)
    (cond
      ((nil? col) nil)
      ((not (list? col)) col)
      (true
        (let
          ((s (if (nil? start) 0 start))
            (e (if (nil? end) (len col) (+ end 1))))
          (slice col s e))))))

(define
  hs-pick-first
  (fn
    (col n)
    (cond
      ((nil? col) nil)
      (true
        (let
          ((m (if (nil? n) 1 n)))
          (cond
            ((string? col) (slice col 0 m))
            ((list? col) (slice col 0 m))
            (true col)))))))

(define
  hs-pick-last
  (fn
    (col n)
    (cond
      ((nil? col) nil)
      (true
        (let
          ((total (cond ((string? col) (len col)) ((list? col) (len col)) (true 0))))
          (let
            ((start (max 0 (- total n))))
            (cond
              ((string? col) (slice col start total))
              ((list? col) (slice col start total))
              (true col))))))))

(define
  hs-pick-random
  (fn
    (col n)
    (cond
      ((nil? col) nil)
      (true
        (let
          ((total (cond ((string? col) (len col)) ((list? col) (len col)) (true 0))))
          (cond
            ((= total 0) (if (nil? n) nil (list)))
            ((nil? n) (nth col 0))
            (true
              (let
                ((m (max 0 (if (> n total) total n))))
                (cond
                  ((string? col) (slice col 0 m))
                  ((list? col) (slice col 0 m))
                  (true col))))))))))

(define
  hs-pick-items
  (fn
    (col start end)
    (cond
      ((nil? col) nil)
      (true
        (let
          ((n (cond ((string? col) (len col)) ((list? col) (len col)) (true 0))))
          (let
            ((s (cond ((= start "hs-pick-start") 0) ((= start "hs-pick-end") n) ((and (number? start) (< start 0)) (max 0 (+ n start))) (true start)))
              (e
                (cond
                  ((= end "hs-pick-end") n)
                  ((= end "hs-pick-start") 0)
                  ((and (number? end) (< end 0)) (max 0 (+ n end)))
                  (true end))))
            (cond
              ((string? col) (slice col s e))
              ((list? col) (slice col s e))
              (true col))))))))

(define
  hs-pick-match
  (fn
    (regex haystack)
    (cond
      ((nil? regex) nil)
      ((nil? haystack) nil)
      (true (regex-match (hs-pick-regex-pattern regex) haystack)))))

(begin
  (define
    hs-pick-regex-ci-char
    (fn
      (ch)
      (let
        ((lo (lower ch)) (up (upper ch)))
        (if (= lo up) ch (str "[" lo up "]")))))
  (define
    hs-pick-regex-ci
    (fn
      (pat)
      (let
        ((n (len pat)) (out ""))
        (let
          ((i 0))
          (let
            ((loop (fn () nil)))
            (do
              (set!
                loop
                (fn
                  ()
                  (cond
                    ((>= i n) nil)
                    (true
                      (let
                        ((ch (char-at pat i)))
                        (cond
                          ((= ch "\\")
                            (do
                              (set! out (str out ch))
                              (set! i (+ i 1))
                              (when
                                (< i n)
                                (set! out (str out (char-at pat i)))
                                (set! i (+ i 1)))
                              (loop)))
                          (true
                            (do
                              (set! out (str out (hs-pick-regex-ci-char ch)))
                              (set! i (+ i 1))
                              (loop)))))))))
              (loop)
              out))))))
  (define
    hs-pick-regex-pattern
    (fn
      (regex)
      (cond
        ((nil? regex) "")
        ((list? regex)
          (let
            ((pat (nth regex 0)) (flags (nth regex 1)))
            (cond
              ((nil? flags) pat)
              ((string-contains? flags "i") (hs-pick-regex-ci pat))
              (true pat))))
        (true regex)))))

(define
  hs-pick-matches
  (fn
    (regex haystack)
    (cond
      ((nil? regex) nil)
      ((nil? haystack) nil)
      (true
        (let
          ((pat (hs-pick-regex-pattern regex)))
          (let
            ((found (regex-find-all pat haystack)))
            (map (fn (m) (list m)) found)))))))

(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) (if (nil? s) nil (split s sep))))

(define
  hs-joined-by
  (fn
    (col sep)
    (cond
      ((nil? col) nil)
      ((list? col)
        (join sep (map (fn (x) (if (nil? x) "" (str x))) col)))
      (true col))))

(define
  hs-sorted-by
  (fn
    (coll key-fn)
    (if
      (not (list? coll))
      coll
      (sort
        (fn
          (a b)
          (let
            ((ka (key-fn a)) (kb (key-fn b)))
            (cond
              ((nil? ka) (not (nil? kb)))
              ((nil? kb) false)
              (true (< ka kb)))))
        coll))))

(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))))

;; ── SourceInfo API ────────────────────────────────────────────────

(define
  hs-dom-has-var?
  (fn
    (el name)
    (if
      (nil? el)
      false
      (let
        ((store (host-get el "__hs_vars")))
        (if (nil? store) false (host-call store "hasOwnProperty" name))))))

(define
  hs-dom-get-var-raw
  (fn
    (el name)
    (let
      ((store (host-get el "__hs_vars")))
      (if (nil? store) nil (host-get store name)))))

(define
  hs-dom-set-var-raw!
  (fn
    (el name val)
    (let
      ((changed (not (and (hs-dom-has-var? el name) (= (hs-dom-get-var-raw el name) val)))))
      (do
        (when
          (nil? (host-get el "__hs_vars"))
          (host-set! el "__hs_vars" (host-new "Object")))
        (host-set! (host-get el "__hs_vars") name val)
        (when changed (hs-dom-fire-watchers! el name val))))))

(define
  hs-dom-resolve-start
  (fn
    (el)
    (if
      (nil? el)
      nil
      (let
        ((scope (dom-get-attr el "dom-scope")))
        (cond
          ((or (nil? scope) (= scope "") (= scope "isolated")) el)
          ((starts-with? scope "closest ")
            (dom-closest el (slice scope 8 (len scope))))
          ((starts-with? scope "parent of ")
            (let
              ((match (dom-closest el (slice scope 10 (len scope)))))
              (if match (dom-parent match) nil)))
          (true el))))))

(define
  hs-dom-walk
  (fn
    (el name)
    (cond
      ((nil? el) nil)
      ((hs-dom-has-var? el name) (hs-dom-get-var-raw el name))
      ((= (dom-get-attr el "dom-scope") "isolated") nil)
      (true (hs-dom-walk (dom-parent el) name)))))

(define
  hs-dom-find-owner
  (fn
    (el name)
    (cond
      ((nil? el) nil)
      ((hs-dom-has-var? el name) el)
      ((= (dom-get-attr el "dom-scope") "isolated") nil)
      (true (hs-dom-find-owner (dom-parent el) name)))))

(define
  hs-dom-get
  (fn (el name) (hs-dom-walk (hs-dom-resolve-start el) name)))

(define
  hs-dom-set!
  (fn
    (el name val)
    (let
      ((start (hs-dom-resolve-start el)))
      (let
        ((owner (hs-dom-find-owner start name)))
        (hs-dom-set-var-raw! (if owner owner start) name val)))))

(define _hs-dom-watchers (list))

(define
  hs-dom-watch!
  (fn
    (el name handler)
    (set! _hs-dom-watchers (cons (list el name handler) _hs-dom-watchers))))

(define
  hs-dom-fire-watchers!
  (fn
    (el name val)
    (for-each
      (fn
        (entry)
        (when
          (and
            (= (nth entry 1) name)
            (hs-dom-is-ancestor? el (nth entry 0)))
          ((nth entry 2) val)))
      _hs-dom-watchers)))

(define
  hs-null-error!
  (fn
    (selector)
    (let
      ((msg (str "'" selector "' is null")))
      (host-set! (host-global "window") "_hs_null_error" msg)
      (guard (_null-e (true nil)) (raise msg)))))

(define
  hs-named-target
  (fn (selector value) (if (nil? value) (hs-null-error! selector) value)))

(define
  hs-named-target-list
  (fn
    (selector values)
    (if (nil? values) (hs-null-error! selector) values)))

(define
  hs-query-named-all
  (fn
    (selector)
    (let
      ((results (hs-query-all selector)))
      (if
        (and
          (or (nil? results) (and (list? results) (= (len results) 0)))
          (string? selector)
          (> (len selector) 0)
          (= (substring selector 0 1) "#"))
        (hs-null-error! selector)
        results))))

(define
  hs-dom-is-ancestor?
  (fn
    (a b)
    (cond
      ((nil? b) false)
      ((= a b) true)
      (true (hs-dom-is-ancestor? a (dom-parent b))))))

(define
  hs-win-call
  (fn
    (fn-name args)
    (let
      ((fn (host-get (host-global "window") fn-name)))
      (if
        fn
        (let
          ((result (host-call-fn-raising fn args)))
          (if
            (= result "__hs_js_throw__")
            (raise (host-take-js-throw))
            (if
              (= result "__hs_async_error__")
              (raise "__hs_async_error__")
              (if
                (= (host-typeof result) "promise")
                (let
                  ((state (host-promise-state result)))
                  (if
                    (and state (= (host-get state "ok") false))
                    (do
                      (host-set!
                        (host-global "window")
                        "__hs_async_error"
                        (host-get state "value"))
                      (raise "__hs_async_error__"))
                    (if state (host-get state "value") result)))
                result))))
        (let
          ((msg (str "'" fn-name "' is null")))
          (host-set! (host-global "window") "_hs_null_error" msg)
          (guard (_null-e (true nil)) (raise msg)))))))

(define
  hs-source-for
  (fn
    (node)
    (substring (get node :src) (get node :start) (get node :end))))

(define
  hs-line-for
  (fn
    (node)
    (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)))
      (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)
          (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))))

(define
  hs-stream-consume
  (fn
    (s)
    (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))))
      (let
        ((p (find-pos (dict-get s :pos))))
        (let
          ((tok (if (>= p n) hs-eof-sentinel (nth lst p))))
          (do
            (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)))

;; ── WebSocket / socket feature ───────────────────────────────────

(define
  hs-try-json-parse
  (fn (s) (host-call (host-global "JSON") "parse" s)))

(define
  hs-socket-resolve-rpc!
  (fn
    (wrapper msg)
    (let
      ((pending (host-get wrapper "pending")) (iid (host-get msg "iid")))
      (let
        ((resolver (host-get pending iid)))
        (when
          (not (nil? resolver))
          (if
            (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-socket-register!
  (fn
    (name-path url timeout-ms handler json?)
    (let
      ((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
        ((ws (host-new "WebSocket" ws-url)))
        (let
          ((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
              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)))))

