rose-ash/lib/hyperscript/htmx.sx

;; htmx.sx — hx-* attributes as hyperscript sugar (htmx 4.0 compat)
;;
;; Every hx- attribute is syntactic sugar for a hyperscript event handler.
;; htmx-activate! scans hx-* attributes, builds the equivalent handler
;; from the same runtime primitives the hyperscript compiler emits,
;; and registers it via hs-on — same bytecode path, zero duplication.
;;
;; The translation:
;;   <button hx-get="/api" hx-target="#list" hx-swap="innerHTML">
;; is exactly:
;;   <button _="on click fetch /api then put it into #list">
;; Both use hs-on + perform io-fetch + dom-set-inner-html. Same runtime.
;;
;; htmx 4.0 features:
;;   - hx-action/hx-method as verb alternative
;;   - :inherited modifier for explicit attribute inheritance
;;   - Swap aliases: before/after/prepend/append + innerMorph/outerMorph
;;   - htmx:phase:action event naming
;;   - All responses swap (except 204/304)
;;   - hx-ignore (processing) vs hx-disable (form elements)
;;   - hx-config per-element JSON config
;;
;; Entry points:
;;   (htmx-activate! el)        — activate hx-* attributes on one element
;;   (htmx-boot-subtree! root)  — activate all hx-* elements in subtree

;; ── Config defaults (htmx 4.0) ─────────────────────────────────

(define HX-CONFIG-DEFAULTS {:defaultTimeout 60000 :transitions false :defaultSwap "innerHTML" :requestClass "htmx-request" :defaultSettleDelay 1 :implicitInheritance false :noSwap (list 204 304)})

(define HX-REQUEST-CLASS "htmx-request")

;; ── Per-element config ──────────────────────────────────────────

(define
  url-encode-params
  (fn
    (params)
    "Encode dict as URL query string: {:a 1 :b 2} → 'a=1&b=2'."
    (let
      ((pairs (map (fn (key) (str (str key) "=" (get params key))) (keys params))))
      (join "&" pairs))))

;; ── Attribute inheritance (v4: explicit with :inherited) ────────

(define
  sx-url-with-params
  (fn
    (url params)
    "Embed params as :key \"value\" keywords inside an SX URL's innermost paren.\n     /sx/(a.(b)) + {:q \"hi\"} → /sx/(a.(b :q \"hi\"))"
    (if
      (not (contains? url "("))
      (str url "?" (url-encode-params params))
      (let
        ((i (- (len url) 1)) (count 0))
        (when
          (and (>= i 0) (= (nth url i) ")"))
          (set! count (+ count 1))
          (set! i (- i 1)))
        (when
          (and (>= i 0) (= (nth url i) ")"))
          (set! count (+ count 1))
          (set! i (- i 1)))
        (when
          (and (>= i 0) (= (nth url i) ")"))
          (set! count (+ count 1))
          (set! i (- i 1)))
        (when
          (and (>= i 0) (= (nth url i) ")"))
          (set! count (+ count 1))
          (set! i (- i 1)))
        (when
          (and (>= i 0) (= (nth url i) ")"))
          (set! count (+ count 1))
          (set! i (- i 1)))
        (when
          (and (>= i 0) (= (nth url i) ")"))
          (set! count (+ count 1))
          (set! i (- i 1)))
        (let
          ((base (slice url 0 (+ i 1)))
            (suffix (slice url (+ i 1)))
            (kw-str
              (join
                " "
                (map
                  (fn (k) (str ":" k " \"" (get params k) "\""))
                  (keys params)))))
          (str base " " kw-str suffix))))))

(define
  hx-element-config
  (fn
    (el key)
    "Read config value: hx-config JSON on element → global defaults."
    (let
      ((cfg-raw (dom-get-attr el "hx-config")))
      (if
        cfg-raw
        (let
          ((cfg (json-parse cfg-raw)))
          (or (get cfg key) (get HX-CONFIG-DEFAULTS key)))
        (get HX-CONFIG-DEFAULTS key)))))

;; ── Verb scanning (v4: hx-get/post/put/delete/patch + hx-action/hx-method) ──

(define
  hx-walk-inherited
  (fn
    (el attr)
    "Walk ancestors looking for attr:inherited."
    (let
      ((inherited-attr (str attr ":inherited")) (parent (dom-parent el)))
      (if
        (not parent)
        nil
        (let
          ((val (dom-get-attr parent inherited-attr)))
          (if val val (hx-walk-inherited parent attr)))))))

;; ── Default trigger ─────────────────────────────────────────────

(define
  hx-resolve-attr
  (fn
    (el attr)
    "Resolve attribute, checking :inherited on ancestors.\n     v4 default: no implicit inheritance."
    (or (dom-get-attr el attr) (hx-walk-inherited el attr))))

;; ── Time parsing ────────────────────────────────────────────────

(define
  hx-verb-info
  (fn
    (el)
    "Scan verb attributes. Returns (method url) or nil.\n     v4 supports both hx-get='/url' and hx-action='/url' hx-method='get'."
    (let
      ((get-url (dom-get-attr el "hx-get"))
        (post-url (dom-get-attr el "hx-post"))
        (put-url (dom-get-attr el "hx-put"))
        (del-url (dom-get-attr el "hx-delete"))
        (patch-url (dom-get-attr el "hx-patch"))
        (action (dom-get-attr el "hx-action"))
        (method (dom-get-attr el "hx-method")))
      (cond
        get-url
        (list "GET" get-url)
        post-url
        (list "POST" post-url)
        put-url
        (list "PUT" put-url)
        del-url
        (list "DELETE" del-url)
        patch-url
        (list "PATCH" patch-url)
        (and action method)
        (list (upcase method) action)
        action
        (list "GET" action)
        true
        nil))))

;; ── Trigger parsing ─────────────────────────────────────────────

(define
  hx-default-trigger
  (fn
    (el)
    "Default trigger: form→submit, input/select/textarea→change, else→click."
    (let
      ((tag (downcase (dom-tag-name el))))
      (cond
        ((= tag "form") "submit")
        ((or (= tag "input") (= tag "textarea") (= tag "select")) "change")
        (true "click")))))

;; ── Target resolution ───────────────────────────────────────────

(define
  hx-parse-time
  (fn
    (raw)
    "Parse time spec: '500ms'→500, '1s'→1000, '2m'→120000."
    (cond
      ((not raw) nil)
      ((ends-with? raw "ms") (parse-number (slice raw 0 (- (len raw) 2))))
      ((ends-with? raw "s")
        (* 1000 (parse-number (slice raw 0 (- (len raw) 1)))))
      ((ends-with? raw "m")
        (* 60000 (parse-number (slice raw 0 (- (len raw) 1)))))
      (true (parse-number raw)))))

;; ── Swap mode resolution (v4 aliases + morph) ───────────────────

(define
  hx-parse-trigger
  (fn
    (raw el)
    "Parse hx-trigger spec. Returns {:event :delay :throttle :once :changed :from :filter}."
    (if
      (not raw)
      {:filter nil :delay nil :throttle nil :from nil :event (hx-default-trigger el) :changed false :once false}
      (let
        ((parts (split (trim raw) " "))
          (event (first parts))
          (delay-ms nil)
          (throttle-ms nil)
          (once false)
          (changed false)
          (from-sel nil)
          (filter nil))
        (for-each
          (fn
            (part)
            (cond
              ((starts-with? part "delay:")
                (set! delay-ms (hx-parse-time (slice part 6))))
              ((starts-with? part "throttle:")
                (set! throttle-ms (hx-parse-time (slice part 9))))
              ((= part "once") (set! once true))
              ((= part "changed") (set! changed true))
              ((starts-with? part "from:") (set! from-sel (slice part 5)))
              ((starts-with? part "[") (set! filter part))
              (true nil)))
          (rest parts))
        {:filter filter :delay delay-ms :throttle throttle-ms :from from-sel :event event :changed changed :once once}))))

(define
  hx-resolve-target
  (fn
    (el spec)
    "Resolve hx-target: nil→el, 'this'→el, 'closest sel'→walk up, '#id'→query."
    (let
      ((target-spec (or spec (hx-resolve-attr el "hx-target"))))
      (cond
        ((not target-spec) el)
        ((= target-spec "this") el)
        ((= target-spec "body") (dom-body))
        ((starts-with? target-spec "closest ")
          (dom-closest el (slice target-spec 8)))
        ((starts-with? target-spec "find ")
          (dom-query el (slice target-spec 5)))
        ((starts-with? target-spec "next ")
          (hs-next el (slice target-spec 5)))
        ((starts-with? target-spec "previous ")
          (hs-previous el (slice target-spec 9)))
        (true (dom-query (dom-body) target-spec))))))

;; ── Swap execution (all v4 modes) ───────────────────────────────

(define
  hx-normalize-swap-mode
  (fn
    (mode)
    "Normalize v4 swap aliases to canonical names."
    (cond
      ((= mode "before") "beforebegin")
      ((= mode "after") "afterend")
      ((= mode "prepend") "afterbegin")
      ((= mode "append") "beforeend")
      (true mode))))

;; ── Select fragment ─────────────────────────────────────────────

(define
  hx-parse-swap-spec
  (fn
    (raw)
    "Parse swap spec with all v4 modifiers.\n     Returns {:mode :swap-delay :settle-delay :scroll :show-target :transition :strip :target :ignore-title}."
    (if
      (not raw)
      {:ignore-title false :transition false :target nil :strip false :scroll nil :mode "innerHTML" :settle-delay nil :show-target nil :swap-delay nil}
      (let
        ((parts (split raw " "))
          (mode (hx-normalize-swap-mode (first parts)))
          (swap-delay nil)
          (settle-delay nil)
          (scroll nil)
          (show-target nil)
          (transition false)
          (strip false)
          (target nil)
          (ignore-title false))
        (for-each
          (fn
            (part)
            (cond
              ((starts-with? part "swap:")
                (set! swap-delay (hx-parse-time (slice part 5))))
              ((starts-with? part "settle:")
                (set! settle-delay (hx-parse-time (slice part 7))))
              ((starts-with? part "scroll:") (set! scroll (slice part 7)))
              ((starts-with? part "show:") (set! scroll (slice part 5)))
              ((starts-with? part "showTarget:")
                (set! show-target (slice part 11)))
              ((starts-with? part "scrollTarget:")
                (set! show-target (slice part 13)))
              ((= part "transition:true") (set! transition true))
              ((= part "strip:true") (set! strip true))
              ((starts-with? part "target:") (set! target (slice part 7)))
              ((= part "ignoreTitle:true") (set! ignore-title true))
              (true nil)))
          (rest parts))
        {:ignore-title ignore-title :transition transition :target target :strip strip :scroll scroll :mode mode :settle-delay settle-delay :show-target show-target :swap-delay swap-delay}))))

;; ── Request building (v4 headers) ───────────────────────────────

(define
  hx-swap!
  (fn
    (target content mode)
    "Swap content into target. Supports all v4 modes."
    (cond
      ((= mode "innerHTML") (dom-set-inner-html target content))
      ((= mode "outerHTML")
        (do
          (dom-insert-adjacent-html target "afterend" content)
          (dom-remove target)))
      ((= mode "afterend")
        (dom-insert-adjacent-html target "afterend" content))
      ((= mode "beforeend")
        (dom-insert-adjacent-html target "beforeend" content))
      ((= mode "afterbegin")
        (dom-insert-adjacent-html target "afterbegin" content))
      ((= mode "beforebegin")
        (dom-insert-adjacent-html target "beforebegin" content))
      ((= mode "delete") (dom-remove target))
      ((= mode "none") nil)
      ((= mode "textContent") (dom-set-text-content target content))
      ((= mode "innerMorph") (dom-set-inner-html target content))
      ((= mode "outerMorph")
        (do
          (dom-insert-adjacent-html target "afterend" content)
          (dom-remove target)))
      (true (dom-set-inner-html target content)))))

(define
  hx-select-fragment
  (fn
    (html selector)
    "Extract fragment matching selector from HTML response (hx-select)."
    (if
      (not selector)
      html
      (let
        ((doc (dom-parse-html html)))
        (let
          ((found (dom-query doc selector)))
          (if found (dom-outer-html found) html))))))

(define
  hx-element-source-id
  (fn
    (el)
    "Format element as tagName#id for v4 HX-Source header."
    (let
      ((tag (downcase (dom-tag-name el))) (id (dom-get-attr el "id")))
      (if id (str tag "#" id) tag))))

(define
  hx-form-values
  (fn
    (form-el)
    "Extract name=value pairs from form inputs."
    (let
      ((inputs (dom-query-all form-el "input, select, textarea"))
        (result {}))
      (for-each
        (fn
          (input)
          (let
            ((name (dom-get-attr input "name"))
              (val (element-value input)))
            (when name (set! result (assoc result name val)))))
        inputs)
      result)))

(define
  hx-collect-params
  (fn
    (el method)
    "Collect request params: form values + hx-include + hx-vals + element name/value."
    (let
      ((params {}))
      (when
        (= (downcase (dom-tag-name el)) "form")
        (set! params (hx-form-values el)))
      (let
        ((tag (downcase (dom-tag-name el))))
        (when
          (or (= tag "input") (= tag "select") (= tag "textarea"))
          (let
            ((name (dom-get-attr el "name")))
            (when name (set! params (assoc params name (element-value el)))))))
      (let
        ((include-sel (dom-get-attr el "hx-include")))
        (when
          include-sel
          (let
            ((other (dom-query include-sel)))
            (when other (set! params (merge params (hx-form-values other)))))))
      (let
        ((vals-raw (dom-get-attr el "hx-vals")))
        (when
          vals-raw
          (let
            ((extra (json-parse vals-raw)))
            (when extra (set! params (merge params extra))))))
      params)))

;; ── OOB processing (v4: main swap first, then OOB) ─────────────

(define
  hx-build-headers
  (fn
    (el target-el)
    "Build v4 request headers."
    (let
      ((headers {:HX-Source (hx-element-source-id el) :HX-Request "true" :Accept "text/html" :HX-Request-Type "partial"}))
      (when
        target-el
        (set!
          headers
          (assoc headers :HX-Target (hx-element-source-id target-el))))
      (set! headers (assoc headers :HX-Current-URL (browser-location-href)))
      (let
        ((extra-raw (hx-resolve-attr el "hx-headers")))
        (when
          extra-raw
          (let
            ((extra (json-parse extra-raw)))
            (when extra (set! headers (merge headers extra))))))
      headers)))

;; ── History ─────────────────────────────────────────────────────

(define
  hx-request
  (fn
    (el url method target-el)
    "Issue HTTP request with v4 conventions.\n     Returns {:status :body :headers} for status-based dispatch."
    (let
      ((params (hx-collect-params el method))
        (headers (hx-build-headers el target-el))
        (encoding (dom-get-attr el "hx-encoding"))
        (etag (dom-get-data el "hx-etag")))
      (let
        ((fetch-url (if (or (= method "GET") (= method "DELETE")) (if (empty? params) url (str url "?" (url-encode-params params))) url))
          (body
            (if
              (or (= method "GET") (= method "DELETE"))
              nil
              (if
                (= encoding "multipart/form-data")
                params
                (json-stringify params)))))
        (when
          (and body (not (= encoding "multipart/form-data")))
          (set! headers (assoc headers :Content-Type "application/json")))
        (when etag (set! headers (assoc headers :If-None-Match etag)))
        (let
          ((raw (perform (list (quote io-fetch) fetch-url method body headers))))
          (let
            ((status (host-get raw "status"))
              (resp-body (host-get raw "body"))
              (resp-headers (host-get raw "headers")))
            (when
              (host-get resp-headers "etag")
              (dom-set-data el "hx-etag" (host-get resp-headers "etag")))
            {:status status :headers resp-headers :body resp-body}))))))

;; ── Indicator ───────────────────────────────────────────────────

(define
  hx-process-oob!
  (fn
    (response-html)
    "Process out-of-band swaps: elements with hx-swap-oob."
    (let
      ((doc (dom-parse-html response-html)))
      (let
        ((oob-els (dom-query-all doc "[hx-swap-oob]")))
        (for-each
          (fn
            (oob-el)
            (let
              ((spec (dom-get-attr oob-el "hx-swap-oob"))
                (id (dom-get-attr oob-el "id")))
              (when
                id
                (let
                  ((target (dom-query (dom-body) (str "#" id)))
                    (mode
                      (hx-normalize-swap-mode
                        (if (= spec "true") "innerHTML" spec))))
                  (when
                    target
                    (dom-remove-attr oob-el "hx-swap-oob")
                    (hx-swap! target (dom-outer-html oob-el) mode))))))
          oob-els)))))

(define
  hx-process-partials!
  (fn
    (response-html)
    "Process <hx-partial> elements: each specifies its own target + swap.\n     v4: swaps in document order after main content."
    (let
      ((doc (dom-parse-html response-html)))
      (let
        ((partials (dom-query-all doc "hx-partial")))
        (for-each
          (fn
            (partial)
            (let
              ((target-sel (dom-get-attr partial "hx-target"))
                (swap-mode (or (dom-get-attr partial "hx-swap") "innerHTML")))
              (when
                target-sel
                (let
                  ((target (dom-query (dom-body) target-sel))
                    (mode (hx-normalize-swap-mode swap-mode)))
                  (when
                    target
                    (hx-swap! target (dom-inner-html partial) mode))))))
          partials)))))

;; ── Disable form elements (v4: hx-disable) ─────────────────────

(define
  hx-parse-status-modifiers
  (fn
    (value)
    "Parse hx-status modifier string: 'swap:innerHTML target:#errors push:false'."
    (let
      ((parts (split value " ")) (result {:target nil :transition nil :swap nil :select nil :push nil :replace nil}))
      (for-each
        (fn
          (part)
          (cond
            ((starts-with? part "swap:")
              (set! result (assoc result :swap (slice part 5))))
            ((starts-with? part "target:")
              (set! result (assoc result :target (slice part 7))))
            ((starts-with? part "select:")
              (set! result (assoc result :select (slice part 7))))
            ((starts-with? part "push:")
              (set! result (assoc result :push (slice part 5))))
            ((starts-with? part "replace:")
              (set! result (assoc result :replace (slice part 8))))
            ((starts-with? part "transition:")
              (set! result (assoc result :transition (slice part 11))))
            (true nil)))
        parts)
      result)))

(define
  hx-status-matches?
  (fn
    (status-str pattern)
    "Check if status matches pattern: '404'='404', '50x'=500-509, '5xx'=500-599."
    (cond
      ((= status-str pattern) true)
      ((and (= (len pattern) 3) (ends-with? pattern "xx") (= (slice status-str 0 1) (slice pattern 0 1)))
        true)
      ((and (= (len pattern) 3) (ends-with? pattern "x") (not (ends-with? pattern "xx")) (= (slice status-str 0 2) (slice pattern 0 2)))
        true)
      (true false))))

;; ── Confirm ─────────────────────────────────────────────────────

(define
  hx-parse-status-rules
  (fn
    (el)
    "Scan element for hx-status:CODE attributes. Returns list of rule dicts."
    (let
      ((attrs (dom-attr-list el)) (rules (list)))
      (for-each
        (fn
          (attr)
          (let
            ((name (get attr :name)) (value (get attr :value)))
            (when
              (starts-with? name "hx-status:")
              (let
                ((code-str (slice name 10))
                  (specificity
                    (cond
                      ((not (ends-with? code-str "x")) 3)
                      ((and (ends-with? code-str "x") (not (ends-with? code-str "xx")))
                        2)
                      (true 1))))
                (set!
                  rules
                  (append
                    rules
                    (list
                      (merge {:specificity specificity :code code-str} (hx-parse-status-modifiers value)))))))))
        attrs)
      rules)))

;; ── v4 event dispatch ───────────────────────────────────────────

(define
  hx-match-status
  (fn
    (status rules)
    "Match HTTP status against rules. Returns best match (highest specificity) or nil."
    (let
      ((status-str (str status)) (best nil) (best-spec 0))
      (for-each
        (fn
          (rule)
          (let
            ((pattern (get rule :code)) (spec (get rule :specificity)))
            (when
              (and
                (hx-status-matches? status-str pattern)
                (> spec best-spec))
              (set! best rule)
              (set! best-spec spec))))
        rules)
      best)))

;; ── Handler builder ─────────────────────────────────────────────
;;
;; Builds a handler fn that calls the same runtime primitives as
;; compiled hyperscript. The handler for:
;;   <button hx-get="/api" hx-target="#list" hx-swap="innerHTML"
;;           hx-indicator="#spinner" hx-confirm="Sure?">
;; produces identical runtime calls to:
;;   on click confirm 'Sure?' add .htmx-request to #spinner
;;     fetch /api put the result into #list
;;     remove .htmx-request from #spinner

(define
  hx-handle-history!
  (fn
    (el url)
    "Push or replace URL based on hx-push-url / hx-replace-url."
    (let
      ((push (hx-resolve-attr el "hx-push-url"))
        (replace (hx-resolve-attr el "hx-replace-url")))
      (cond
        ((= push "true") (browser-push-state {:scrollY 0} "" url))
        ((and push (not (= push "false")))
          (browser-push-state {:scrollY 0} "" push))
        ((= replace "true") (browser-replace-state {:scrollY 0} "" url))
        ((and replace (not (= replace "false")))
          (browser-replace-state {:scrollY 0} "" replace))
        (true nil)))))

;; ── Trigger wrappers ────────────────────────────────────────────

(define
  hx-indicator-on!
  (fn
    (el)
    "Add request class to element + indicator targets."
    (dom-add-class el HX-REQUEST-CLASS)
    (let
      ((sel (hx-resolve-attr el "hx-indicator")))
      (when
        sel
        (for-each
          (fn (ind) (dom-add-class ind HX-REQUEST-CLASS))
          (dom-query-all (dom-body) sel))))))

(define
  hx-indicator-off!
  (fn
    (el)
    "Remove request class from element + indicator targets."
    (dom-remove-class el HX-REQUEST-CLASS)
    (let
      ((sel (hx-resolve-attr el "hx-indicator")))
      (when
        sel
        (for-each
          (fn (ind) (dom-remove-class ind HX-REQUEST-CLASS))
          (dom-query-all (dom-body) sel))))))

(define
  hx-disable-inputs!
  (fn
    (el)
    "Disable form elements during request (v4 hx-disable)."
    (let
      ((sel (dom-get-attr el "hx-disable")))
      (when
        sel
        (for-each
          (fn (input) (dom-set-attr input "disabled" "true"))
          (dom-query-all (dom-body) sel))))))

;; ── Trigger registration ────────────────────────────────────────

(define
  hx-enable-inputs!
  (fn
    (el)
    "Re-enable form elements after request."
    (let
      ((sel (dom-get-attr el "hx-disable")))
      (when
        sel
        (for-each
          (fn (input) (dom-remove-attr input "disabled"))
          (dom-query-all (dom-body) sel))))))

;; ── Activation ──────────────────────────────────────────────────

(define
  hx-confirm?
  (fn
    (el)
    "Show confirm dialog if hx-confirm set. Returns true to proceed."
    (let
      ((msg (hx-resolve-attr el "hx-confirm")))
      (if msg (browser-confirm msg) true))))

;; ── Boot ────────────────────────────────────────────────────────

(define
  hx-validate-form?
  (fn
    (el)
    "Check form validity if hx-validate is set. Returns true to proceed."
    (let
      ((validate (dom-get-attr el "hx-validate")))
      (if
        validate
        (let
          ((form (if (= (downcase (dom-tag-name el)) "form") el (dom-closest el "form"))))
          (if form (host-call form "checkValidity") true))
        true))))

(define
  hx-parse-sync-spec
  (fn
    (raw)
    "Parse hx-sync='selector:strategy'. Returns {:selector :strategy :queue-mode} or nil."
    (if
      (not raw)
      nil
      (let
        ((colon-pos (index-of raw ":")))
        (if
          (not colon-pos)
          {:strategy "drop" :selector raw :queue-mode nil}
          (let
            ((selector (trim (slice raw 0 colon-pos)))
              (rest-str (trim (slice raw (+ colon-pos 1)))))
            (let
              ((strategy (if (starts-with? rest-str "queue") "queue" rest-str))
                (qm
                  (if
                    (starts-with? rest-str "queue")
                    (let
                      ((parts (split rest-str " ")))
                      (if (> (len parts) 1) (nth parts 1) "last"))
                    nil)))
              {:strategy strategy :selector selector :queue-mode qm})))))))

(define
  hx-sync-resolve-target
  (fn
    (el target-sel)
    "Resolve sync target element."
    (cond
      ((= target-sel "this") el)
      ((= target-sel "closest form") (dom-closest el "form"))
      (true (dom-query (dom-body) target-sel)))))

;; ── Boost — progressive enhancement ────────────────────────────

(define
  hx-sync-check!
  (fn
    (el)
    "Check sync strategy. Returns true if request should proceed."
    (let
      ((sync-spec (hx-parse-sync-spec (dom-get-attr el "hx-sync"))))
      (if
        (not sync-spec)
        true
        (let
          ((sync-el (hx-sync-resolve-target el (get sync-spec :selector)))
            (strategy (get sync-spec :strategy)))
          (if
            (not sync-el)
            true
            (let
              ((in-flight (dom-get-data sync-el "hx-sync-in-flight")))
              (cond
                ((= strategy "drop")
                  (if
                    in-flight
                    false
                    (do (dom-set-data sync-el "hx-sync-in-flight" true) true)))
                ((or (= strategy "abort") (= strategy "replace"))
                  (do
                    (when in-flight (dom-dispatch sync-el "htmx:abort" nil))
                    (dom-set-data sync-el "hx-sync-in-flight" true)
                    true))
                ((= strategy "queue")
                  (if
                    in-flight
                    (do (dom-set-data sync-el "hx-sync-queued" el) false)
                    (do (dom-set-data sync-el "hx-sync-in-flight" true) true)))
                (true true)))))))))

(define
  hx-sync-complete!
  (fn
    (el)
    "Mark request complete. Fire queued request if any."
    (let
      ((sync-spec (hx-parse-sync-spec (dom-get-attr el "hx-sync"))))
      (when
        sync-spec
        (let
          ((sync-el (hx-sync-resolve-target el (get sync-spec :selector))))
          (when
            sync-el
            (dom-set-data sync-el "hx-sync-in-flight" false)
            (let
              ((queued (dom-get-data sync-el "hx-sync-queued")))
              (when
                queued
                (dom-set-data sync-el "hx-sync-queued" nil)
                (dom-dispatch queued "click" nil)))))))))

(define
  hx-dispatch!
  (fn
    (el event-name detail)
    "Dispatch htmx event with v4 naming (htmx:phase:action)."
    (dom-dispatch el event-name detail)))

(define
  hx-strip-outer
  (fn
    (html)
    "Remove outer element, return inner content."
    (let
      ((doc (dom-parse-html html)))
      (let
        ((first-child (dom-first-child doc)))
        (if first-child (dom-inner-html first-child) html)))))

(define
  hx-do-swap
  (fn
    (el body status status-rules swap-spec select-sel target url)
    "Execute swap phase: status overrides → select → strip → transition → swap → partials → OOB → history → settle."
    (let
      ((override (hx-match-status status status-rules)))
      (let
        ((eff-swap (if (and override (get override :swap)) (hx-normalize-swap-mode (get override :swap)) (get swap-spec :mode)))
          (eff-target
            (if
              (and override (get override :target))
              (dom-query (dom-body) (get override :target))
              (or target el)))
          (eff-select
            (if
              (and override (get override :select))
              (get override :select)
              select-sel))
          (use-trans
            (or
              (get swap-spec :transition)
              (and override (= (get override :transition) "true")))))
        (hx-dispatch! el "htmx:before:swap" {:target eff-target :swap eff-swap :status status})
        (let
          ((rendered-body (if (and body (starts-with? (trim body) "(")) (let ((parsed (first (parse body)))) (if (and (list? parsed) (= (first parsed) (quote <>))) (let ((children (filter (fn (child) (not (and (list? child) (some (fn (a) (and (= (type-of a) "keyword") (= (keyword-name a) "sx-swap-oob"))) child)))) (rest parsed)))) (render-to-html (cons (quote <>) children))) (render-to-html parsed))) body)))
          (let
            ((content (if eff-select (hx-select-fragment rendered-body eff-select) rendered-body)))
            (let
              ((final (if (get swap-spec :strip) (hx-strip-outer content) content)))
              (if
                use-trans
                (perform
                  (list
                    (quote io-view-transition)
                    (fn () (hx-swap! eff-target final eff-swap))))
                (hx-swap! eff-target final eff-swap))
              (hx-dispatch! el "htmx:after:swap" nil)
              (when
                (not (and override (= (get override :push) "false")))
                (hx-handle-history! el url))
              (hs-wait (or (get swap-spec :settle-delay) 1))
              (hx-dispatch! el "htmx:after:settle" nil))))))))

(define
  hx-make-handler
  (fn
    (el method url)
    "Build handler fn — Phase 2: status dispatch, sync, validate, partials, transitions, etag."
    (let
      ((target-sel (hx-resolve-attr el "hx-target"))
        (swap-spec
          (hx-parse-swap-spec
            (or (hx-resolve-attr el "hx-swap") "innerHTML")))
        (select-sel (dom-get-attr el "hx-select"))
        (status-rules (hx-parse-status-rules el)))
      (fn
        (event)
        (when event (prevent-default event))
        (when
          (and (hx-sync-check! el) (hx-validate-form? el) (hx-confirm? el))
          (hx-dispatch! el "htmx:before:request" {:method method :url url})
          (hx-indicator-on! el)
          (hx-disable-inputs! el)
          (when
            (get swap-spec :swap-delay)
            (hs-wait (get swap-spec :swap-delay)))
          (let
            ((target (hx-resolve-target el target-sel)))
            (let
              ((response (hx-request el url method target)))
              (let
                ((status (get response :status))
                  (body (get response :body)))
                (hx-dispatch! el "htmx:after:request" {:method method :url url :status status})
                (when
                  (not (or (= status 204) (= status 304)))
                  (hx-do-swap
                    el
                    body
                    status
                    status-rules
                    swap-spec
                    select-sel
                    target
                    url))
                (hx-enable-inputs! el)
                (hx-indicator-off! el)
                (hx-sync-complete! el)
                (when
                  (not (or (= status 204) (= status 304)))
                  (htmx-boot-subtree! (or target el))
                  (hs-boot-subtree! (or target el)))))))))))

(define
  hx-wrap-debounce
  (fn
    (handler delay-ms)
    "Wrap handler with debounce (delay: ms before firing)"
    (let
      ((timer nil))
      (fn
        (event)
        (when timer (clear-timeout timer))
        (set!
          timer
          (set-timeout (fn () (set! timer nil) (handler event)) delay-ms))))))

(define
  hx-wrap-throttle
  (fn
    (handler throttle-ms)
    "Wrap handler with throttle."
    (let
      ((last-time 0))
      (fn
        (event)
        (let
          ((now (now-ms)))
          (when
            (> (- now last-time) throttle-ms)
            (set! last-time now)
            (handler event)))))))

(define
  hx-wrap-changed
  (fn
    (handler el)
    "Wrap handler: only fire if element value changed since last fire."
    (let
      ((last-value nil))
      (fn
        (event)
        (let
          ((current (element-value el)))
          (when
            (not (= current last-value))
            (set! last-value current)
            (handler event)))))))

(define
  hx-register-trigger!
  (fn
    (el trigger-spec handler)
    "Register event handler with trigger modifiers applied."
    (let
      ((event (get trigger-spec :event))
        (delay-ms (get trigger-spec :delay))
        (throttle-ms (get trigger-spec :throttle))
        (once (get trigger-spec :once))
        (changed (get trigger-spec :changed))
        (from-sel (get trigger-spec :from)))
      (let
        ((wrapped handler))
        (when changed (set! wrapped (hx-wrap-changed wrapped el)))
        (when delay-ms (set! wrapped (hx-wrap-debounce wrapped delay-ms)))
        (when
          throttle-ms
          (set! wrapped (hx-wrap-throttle wrapped throttle-ms)))
        (let
          ((listen-target (if from-sel (dom-query (dom-body) from-sel) el)))
          (cond
            ((= event "load") (wrapped nil))
            ((or (= event "revealed") (= event "intersect"))
              (perform
                (list
                  (quote io-observe-intersection)
                  el
                  (fn () (wrapped nil)))))
            ((= event "every")
              (when
                delay-ms
                (perform
                  (list
                    (quote io-set-interval)
                    (fn () (wrapped nil))
                    delay-ms))))
            (true (hs-on listen-target event wrapped))))))))

(define
  htmx-activate!
  (fn
    (el)
    "Scan hx-* attributes on element, build and register handler.\n     Also handles: hx-preload, hx-sse-connect, hx-ignore."
    (when
      (not (dom-get-attr el "hx-ignore"))
      (let
        ((verb-info (hx-verb-info el)))
        (when
          (and verb-info (not (dom-get-data el "hx-active")))
          (dom-set-data el "hx-active" true)
          (let
            ((method (first verb-info)) (url (nth verb-info 1)))
            (let
              ((trigger-spec (hx-parse-trigger (dom-get-attr el "hx-trigger") el)))
              (let
                ((handler (hx-make-handler el method url)))
                (hx-register-trigger! el trigger-spec handler))))))
      (when (dom-get-attr el "hx-preload") (hx-preload-register! el))
      (when (dom-get-attr el "hx-sse-connect") (hx-sse-connect! el)))))

(define
  HX-VERB-SELECTORS
  "[hx-get],[hx-post],[hx-put],[hx-delete],[hx-patch],[hx-action],[hx-sse-connect],[hx-preload]")

(define
  htmx-boot!
  (fn
    ()
    "Scan entire document for hx-* elements and activate."
    (for-each htmx-activate! (dom-query-all (dom-body) HX-VERB-SELECTORS))
    (hx-boost-subtree! nil)))

(define hx-preload-cache (list))

(define
  hx-preload-register!
  (fn
    (el)
    "Register preload: prefetch GET on mouseenter, cache result."
    (let
      ((verb-info (hx-verb-info el)))
      (when
        (and verb-info (= (first verb-info) "GET"))
        (let
          ((url (nth verb-info 1)))
          (hs-on
            el
            "mouseenter"
            (fn
              (event)
              (when
                (not (get hx-preload-cache url))
                (let
                  ((raw (perform (list (quote io-fetch) url "GET" nil {:Accept "text/html"}))))
                  (let
                    ((body (perform (list (quote io-parse-text) raw))))
                    (set! hx-preload-cache (assoc hx-preload-cache url body))))))))))))

(define
  hx-parse-sse-swap
  (fn
    (raw)
    "Parse hx-sse-swap='event:#target,event2:#target2:outerHTML'."
    (if
      (not raw)
      (list)
      (map
        (fn
          (spec-raw)
          (let
            ((parts (split (trim spec-raw) ":")))
            (cond
              ((= (len parts) 2) {:target (nth parts 1) :swap "innerHTML" :event (nth parts 0)})
              ((>= (len parts) 3) {:target (nth parts 1) :swap (nth parts 2) :event (nth parts 0)})
              (true {:target nil :swap "innerHTML" :event (trim spec-raw)}))))
        (split raw ",")))))

(define
  hx-sse-connect!
  (fn
    (el)
    "Connect to SSE endpoint. Dispatch events to swap targets."
    (let
      ((url (dom-get-attr el "hx-sse-connect")))
      (when
        url
        (let
          ((swap-specs (hx-parse-sse-swap (dom-get-attr el "hx-sse-swap"))))
          (perform
            (list
              (quote io-event-source)
              url
              (fn
                (event-name data)
                (for-each
                  (fn
                    (spec)
                    (when
                      (= event-name (get spec :event))
                      (let
                        ((target (dom-query (dom-body) (get spec :target))))
                        (when
                          target
                          (hx-swap!
                            target
                            data
                            (hx-normalize-swap-mode (get spec :swap)))
                          (htmx-boot-subtree! target)
                          (hs-boot-subtree! target)))))
                  swap-specs)))))))))

(define
  htmx-boot-subtree!
  (fn
    (root)
    "Activate hx-* elements in subtree. Called after swaps."
    (when
      root
      (for-each htmx-activate! (dom-query-all root HX-VERB-SELECTORS))
      (htmx-activate! root))))

(define
  hx-boost-link!
  (fn
    (link)
    "Boost an anchor: click → AJAX fetch → swap body → push URL."
    (let
      ((href (dom-get-attr link "href")))
      (when
        (and
          href
          (not (hx-verb-info link))
          (not (starts-with? href "http"))
          (not (starts-with? href "mailto"))
          (not (starts-with? href "#")))
        (dom-set-attr link "hx-get" href)
        (when
          (not (dom-get-attr link "hx-target"))
          (dom-set-attr link "hx-target" "body"))
        (when
          (not (dom-get-attr link "hx-swap"))
          (dom-set-attr link "hx-swap" "innerHTML"))
        (when
          (not (dom-get-attr link "hx-push-url"))
          (dom-set-attr link "hx-push-url" "true"))
        (htmx-activate! link)))))

(define
  hx-boost-form!
  (fn
    (form)
    "Boost a form: submit → AJAX."
    (let
      ((action (or (dom-get-attr form "action") ""))
        (method (downcase (or (dom-get-attr form "method") "post"))))
      (when
        (not (hx-verb-info form))
        (dom-set-attr form (str "hx-" method) action)
        (when
          (not (dom-get-attr form "hx-target"))
          (dom-set-attr form "hx-target" "body"))
        (when
          (not (dom-get-attr form "hx-swap"))
          (dom-set-attr form "hx-swap" "innerHTML"))
        (htmx-activate! form)))))

(define
  hx-boost-subtree!
  (fn
    (root)
    "Apply hx-boost to links and forms within scope."
    (let
      ((scope (or root (dom-body))))
      (for-each
        hx-boost-link!
        (dom-query-all scope "[hx-boost] a, a[hx-boost]"))
      (for-each
        hx-boost-form!
        (dom-query-all scope "[hx-boost] form, form[hx-boost]")))))