;; _hyperscript runtime shims
;;
;; Thin wrappers over web/lib/dom.sx and web/lib/browser.sx primitives
;; that implement hyperscript-specific semantics (async transparency,
;; class toggling, event waiting, iteration, type coercion).
;;
;; These are the functions that hs-to-sx (compiler.sx) emits calls to.
;; Each is a pure define — no platform dependency beyond the DOM/browser
;; primitives already available in the SX web platform.

;; ── Event handling ──────────────────────────────────────────────

;; Register an event listener. Returns unlisten function.
;; (hs-on target event-name handler) → unlisten-fn
(define
  hs-each
  (fn
    (target action)
    (if (list? target) (for-each action target) (action target))))

;; Register for every occurrence (no queuing — each fires independently).
;; Stock hyperscript queues by default; "every" disables queuing.
(define
  hs-on
  (fn (target event-name handler) (dom-listen target event-name handler)))

;; Run an initializer function immediately.
;; (hs-init thunk) — called at element boot time
(define
  hs-on-every
  (fn (target event-name handler) (dom-listen target event-name handler)))

;; ── Async / timing ──────────────────────────────────────────────

;; Wait for a duration in milliseconds.
;; In hyperscript, wait is async-transparent — execution pauses.
;; Here we use perform/IO suspension for true pause semantics.
(define hs-init (fn (thunk) (thunk)))

;; Wait for a DOM event on a target.
;; (hs-wait-for target event-name) — suspends until event fires
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))

;; Wait for CSS transitions/animations to settle on an element.
(define
  hs-wait-for
  (fn
    (target event-name)
    (perform (list (quote io-wait-event) target event-name))))

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

;; Toggle a single class on an element.
(define hs-settle (fn (target) (perform (list (quote io-settle) target))))

;; Toggle between two classes — exactly one is active at a time.
(define
  hs-toggle-class!
  (fn (target cls) (host-call (host-get target "classList") "toggle" cls)))

;; Take a class from siblings — add to target, remove from others.
;; (hs-take! target cls) — like radio button class behavior
(define
  hs-toggle-between!
  (fn
    (target cls1 cls2)
    (if
      (dom-has-class? target cls1)
      (do (dom-remove-class target cls1) (dom-add-class target cls2))
      (do (dom-remove-class target cls2) (dom-add-class target cls1)))))

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

;; Put content at a position relative to a target.
;; pos: "into" | "before" | "after"
(define
  hs-toggle-style!
  (fn
    (target prop)
    (let
      ((cur (dom-get-style target prop)))
      (cond
        ((= prop "visibility")
          (if
            (= cur "hidden")
            (dom-set-style target prop "visible")
            (dom-set-style target prop "hidden")))
        ((or (= prop "display") (= prop "opacity"))
          (if
            (or (= cur "none") (= cur "0"))
            (dom-set-style target prop "")
            (dom-set-style target prop (if (= prop "display") "none" "0"))))
        (true
          (if
            (or (= cur "") (= cur nil))
            (dom-set-style target prop "hidden")
            (dom-set-style target prop "")))))))

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

;; Navigate to a URL.
(define
  hs-take!
  (fn
    (target kind name scope)
    (let
      ((els (if scope (if (list? scope) scope (list scope)) (let ((parent (host-get target "parentNode"))) (if parent (dom-child-list parent) (list))))))
      (if
        (= kind "class")
        (do
          (for-each (fn (el) (dom-remove-class el name)) els)
          (dom-add-class target name))
        (do
          (for-each (fn (el) (dom-remove-attr el name)) els)
          (dom-set-attr target name "true"))))))

;; Find next sibling matching a selector (or any sibling).
(define
  hs-put!
  (fn
    (value pos target)
    (cond
      ((= pos "into") (dom-set-inner-html target value))
      ((= pos "before")
        (dom-insert-adjacent-html target "beforebegin" value))
      ((= pos "after") (dom-insert-adjacent-html target "afterend" value))
      ((= pos "start") (dom-insert-adjacent-html target "afterbegin" value))
      ((= pos "end") (dom-insert-adjacent-html target "beforeend" value)))))

;; Find previous sibling matching a selector.
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))

;; First element matching selector within a scope.
(define
  hs-scroll!
  (fn
    (target position)
    (host-call
      target
      "scrollIntoView"
      (list
        (cond
          ((= position "bottom") (dict :block "end"))
          (true (dict :block "start")))))))

;; Last element matching selector.
(define
  hs-halt!
  (fn
    (mode)
    (when
      event
      (host-call event "preventDefault" (list))
      (when (= mode "event") (host-call event "stopPropagation" (list))))))

;; First/last within a specific scope.
(define hs-select! (fn (target) (host-call target "select" (list))))

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

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

;; Repeat a thunk N times.
(define
  hs-next
  (fn
    (target sel)
    (if
      (= sel "*")
      (dom-next-sibling target)
      (let
        ((sibling (dom-next-sibling target)))
        (define
          find-next
          (fn
            (el)
            (cond
              ((nil? el) nil)
              ((dom-matches? el sel) el)
              (true (find-next (dom-next-sibling el))))))
        (find-next sibling)))))

;; Repeat forever (until break — relies on exception/continuation).
(define
  hs-previous
  (fn
    (target sel)
    (if
      (= sel "*")
      (dom-get-prop target "previousElementSibling")
      (let
        ((sibling (dom-get-prop target "previousElementSibling")))
        (define
          find-prev
          (fn
            (el)
            (cond
              ((nil? el) nil)
              ((dom-matches? el sel) el)
              (true (find-prev (dom-get-prop el "previousElementSibling"))))))
        (find-prev sibling)))))

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

;; Fetch a URL, parse response according to format.
;; (hs-fetch url format) — format is "json" | "text" | "html"
(define hs-query-all (fn (sel) (dom-query-all (dom-body) sel)))

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

;; Coerce a value to a type by name.
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
(define
  hs-query-first
  (fn (sel) (host-call (host-global "document") "querySelector" sel)))

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

;; Make a new object of a given type.
;; (hs-make type-name) — creates empty object/collection
(define
  hs-query-last
  (fn
    (sel)
    (let
      ((all (dom-query-all (dom-body) sel)))
      (if (> (len all) 0) (nth all (- (len all) 1)) nil))))

;; ── Behavior installation ───────────────────────────────────────

;; Install a behavior on an element.
;; A behavior is a function that takes (me ...params) and sets up features.
;; (hs-install behavior-fn me ...args)
(define hs-first (fn (scope sel) (dom-query-all scope sel)))

;; ── Measurement ─────────────────────────────────────────────────

;; Measure an element's bounding rect, store as local variables.
;; Returns a dict with x, y, width, height, top, left, right, bottom.
(define
  hs-last
  (fn
    (scope sel)
    (let
      ((all (dom-query-all scope sel)))
      (if (> (len all) 0) (nth all (- (len all) 1)) nil))))

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

;; Transition a CSS property to a value, optionally with duration.
;; (hs-transition target prop value duration)
(define
  hs-repeat-times
  (fn
    (n thunk)
    (define
      do-repeat
      (fn (i) (when (< i n) (do (thunk) (do-repeat (+ i 1))))))
    (do-repeat 0)))

(define
  hs-repeat-forever
  (fn
    (thunk)
    (define do-forever (fn () (thunk) (do-forever)))
    (do-forever)))

(define
  hs-fetch
  (fn
    (url format)
    (let
      ((response (perform (list (quote io-fetch) url))))
      (cond
        ((= format "json") (perform (list (quote io-parse-json) response)))
        ((= format "text") (perform (list (quote io-parse-text) response)))
        ((= format "html") (perform (list (quote io-parse-html) response)))
        (true response)))))

(define
  hs-coerce
  (fn
    (value type-name)
    (cond
      ((= type-name "Int") (floor (+ value 0)))
      ((= type-name "Integer") (floor (+ value 0)))
      ((= type-name "Float") (+ value 0))
      ((= type-name "Number") (+ value 0))
      ((= type-name "String") (str value))
      ((= type-name "Bool") (not (hs-falsy? value)))
      ((= type-name "Boolean") (not (hs-falsy? value)))
      ((= type-name "Array") (if (list? value) value (list value)))
      ((= type-name "JSON") (str value))
      ((= type-name "Object") (if (string? value) value value))
      ((or (= type-name "Fixed") (string-contains? type-name "Fixed:"))
        (let
          ((digits (if (string-contains? type-name ":") (parse-number (nth (split type-name ":") 1)) 0))
            (num (+ value 0)))
          (if
            (= digits 0)
            (str (floor num))
            (let
              ((factor (reduce (fn (acc _) (* acc 10)) 1 (range 0 digits))))
              (let
                ((rounded (/ (floor (+ (* num factor) 0.5)) factor)))
                (str rounded))))))
      ((= type-name "HTML") (str value))
      ((= type-name "Values") value)
      ((= type-name "Fragment") (str value))
      ((= type-name "Date") (str value))
      (true value))))

(define
  hs-add
  (fn (a b) (if (or (string? a) (string? b)) (str a b) (+ a b))))

(define
  hs-make
  (fn
    (type-name)
    (cond
      ((= type-name "Object") (dict))
      ((= type-name "Array") (list))
      ((= type-name "Set") (list))
      ((= type-name "Map") (dict))
      (true (dict)))))

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

(define
  hs-measure
  (fn (target) (perform (list (quote io-measure) target))))

(define
  hs-transition
  (fn
    (target prop value duration)
    (when
      duration
      (dom-set-style
        target
        "transition"
        (str prop " " (/ duration 1000) "s")))
    (dom-set-style target prop value)
    (when duration (hs-settle target))))

(define
  hs-transition-from
  (fn
    (target prop from-val to-val duration)
    (dom-set-style target prop (str from-val))
    (when
      duration
      (dom-set-style
        target
        "transition"
        (str prop " " (/ duration 1000) "s")))
    (dom-set-style target prop (str to-val))
    (when duration (hs-settle target))))

(define
  hs-type-check
  (fn
    (value type-name)
    (if
      (nil? value)
      true
      (cond
        ((= type-name "Number") (number? value))
        ((= type-name "String") (string? value))
        ((= type-name "Boolean") (or (= value true) (= value false)))
        ((= type-name "Array") (list? value))
        ((= type-name "Object") (dict? value))
        (true true)))))





(define
  hs-type-check-strict
  (fn
    (value type-name)
    (if (nil? value) false (hs-type-check value type-name))))

(define
  hs-strict-eq
  (fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
(define
  hs-eq-ignore-case
  (fn (a b) (= (downcase (str a)) (downcase (str b)))))
;; DOM query stub — sandbox returns empty list
(define
  hs-contains-ignore-case?
  (fn
    (haystack needle)
    (contains? (downcase (str haystack)) (downcase (str needle)))))
;; Method dispatch — obj.method(args)
(define
  hs-falsy?
  (fn
    (v)
    (cond
      ((nil? v) true)
      ((= v false) true)
      ((and (string? v) (= v "")) true)
      ((and (list? v) (= (len v) 0)) true)
      ((= v 0) true)
      (true false))))

;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
(define
  hs-matches?
  (fn
    (target pattern)
    (if
      (string? target)
      (if (= pattern ".*") true (string-contains? target pattern))
      false)))
;; Property-based is — check obj.key truthiness
(define
  hs-contains?
  (fn
    (collection item)
    (cond
      ((nil? collection) false)
      ((string? collection) (string-contains? collection (str item)))
      ((list? collection)
        (if
          (list? item)
          (filter (fn (x) (hs-contains? collection x)) item)
          (if
            (= (len collection) 0)
            false
            (if
              (= (first collection) item)
              true
              (hs-contains? (rest collection) item)))))
      (true false))))
;; Array slicing (inclusive both ends)
(define precedes? (fn (a b) (< (str a) (str b))))
;; Collection: sorted by
(define
  hs-empty?
  (fn
    (v)
    (cond
      ((nil? v) true)
      ((string? v) (= (len v) 0))
      ((list? v) (= (len v) 0))
      ((dict? v) (= (len (keys v)) 0))
      (true false))))
;; Collection: sorted by descending
(define
  hs-empty-target!
  (fn
    (target)
    (cond
      ((list? target) (for-each (fn (el) (hs-empty-target! el)) target))
      ((nil? target) nil)
      (true
        (let
          ((tag (dom-get-prop target "tagName")))
          (cond
            ((or (= tag "INPUT") (= tag "TEXTAREA"))
              (let
                ((input-type (dom-get-prop target "type")))
                (if
                  (or (= input-type "checkbox") (= input-type "radio"))
                  (dom-set-prop target "checked" false)
                  (dom-set-prop target "value" ""))))
            ((= tag "FORM") (dom-set-inner-html target ""))
            (true (dom-set-inner-html target ""))))))))
;; Collection: split by
(define hs-first (fn (lst) (first lst)))
;; Collection: joined by
(define hs-last (fn (lst) (last lst)))

(define
  hs-template
  (fn
    (raw)
    (let
      ((result "") (i 0) (n (len raw)))
      (define
        tpl-loop
        (fn
          ()
          (when
            (< i n)
            (let
              ((ch (nth raw i)))
              (if
                (and (= ch "$") (< (+ i 1) n))
                (if
                  (= (nth raw (+ i 1)) "{")
                  (let
                    ((start (+ i 2)))
                    (define
                      find-close
                      (fn
                        (j depth)
                        (if
                          (>= j n)
                          j
                          (if
                            (= (nth raw j) "}")
                            (if
                              (= depth 1)
                              j
                              (find-close (+ j 1) (- depth 1)))
                            (if
                              (= (nth raw j) "{")
                              (find-close (+ j 1) (+ depth 1))
                              (find-close (+ j 1) depth))))))
                    (let
                      ((close (find-close start 1)))
                      (let
                        ((expr-src (slice raw start close)))
                        (do
                          (set!
                            result
                            (str
                              result
                              (cek-eval (hs-to-sx (hs-compile expr-src)))))
                          (set! i (+ close 1))
                          (tpl-loop)))))
                  (let
                    ((start (+ i 1)))
                    (define
                      read-id
                      (fn
                        (j)
                        (if
                          (and
                            (< j n)
                            (let
                              ((c (nth raw j)))
                              (or
                                (and (>= c "a") (<= c "z"))
                                (and (>= c "A") (<= c "Z"))
                                (and (>= c "0") (<= c "9"))
                                (= c "_")
                                (= c "."))))
                          (read-id (+ j 1))
                          j)))
                    (let
                      ((end (read-id start)))
                      (let
                        ((ident (slice raw start end)))
                        (do
                          (set!
                            result
                            (str
                              result
                              (cek-eval (hs-to-sx (hs-compile ident)))))
                          (set! i end)
                          (tpl-loop))))))
                (do
                  (set! result (str result ch))
                  (set! i (+ i 1))
                  (tpl-loop)))))))
      (do (tpl-loop) result))))

(define
  hs-make-object
  (fn
    (pairs)
    (let
      ((d {}))
      (do
        (for-each
          (fn (pair) (dict-set! d (first pair) (nth pair 1)))
          pairs)
        d))))

(define
  hs-method-call
  (fn
    (obj method &rest args)
    (cond
      ((= method "map") (map (first args) obj))
      ((= method "push") (do (append! obj (first args)) obj))
      ((= method "filter") (filter (first args) obj))
      ((= method "join") (join obj (first args)))
      ((= method "indexOf")
        (let
          ((item (first args)))
          (define
            idx-loop
            (fn
              (lst i)
              (if
                (= (len lst) 0)
                -1
                (if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
          (idx-loop obj 0)))
      (true nil))))

(define hs-beep (fn (v) v))

(define hs-prop-is (fn (obj key) (not (hs-falsy? (host-get obj key)))))

(define
  hs-slice
  (fn
    (col start end)
    (let
      ((s (if (nil? start) 0 start))
        (e (if (nil? end) (len col) (+ end 1))))
      (slice col s e))))

(define
  hs-sorted-by
  (fn
    (col key-fn)
    (let
      ((pairs (map (fn (item) (list (key-fn item) item)) col)))
      (map
        (fn (p) (nth p 1))
        (sort (fn (a b) (if (< (first a) (first b)) true false)) pairs)))))

(define
  hs-sorted-by-desc
  (fn
    (col key-fn)
    (let
      ((pairs (map (fn (item) (list (key-fn item) item)) col)))
      (map
        (fn (p) (nth p 1))
        (sort (fn (a b) (if (> (first a) (first b)) true false)) pairs)))))

(define hs-split-by (fn (s sep) (split s sep)))

(define hs-joined-by (fn (col sep) (join sep col)))

(define
  hs-sorted-by
  (fn
    (col key-fn)
    (let
      ((decorated (map (fn (item) (list (key-fn item) item)) col)))
      (let
        ((sorted-dec (sort (map first decorated))))
        (define
          reorder
          (fn
            (keys acc remaining)
            (if
              (= (len keys) 0)
              acc
              (let
                ((k (first keys)))
                (define
                  find-item
                  (fn
                    (lst)
                    (if
                      (= (len lst) 0)
                      nil
                      (if
                        (= (first (first lst)) k)
                        (first lst)
                        (find-item (rest lst))))))
                (let
                  ((found (find-item remaining)))
                  (reorder
                    (rest keys)
                    (append acc (list (nth found 1)))
                    (filter (fn (x) (not (= x found))) remaining)))))))
        (reorder sorted-dec (list) decorated)))))

(define
  hs-sorted-by-desc
  (fn (col key-fn) (reverse (hs-sorted-by col key-fn))))