rose-ash/sx/sx/applications/htmx/runner.sx

;; Test runner island — defined top-level so server registers it
(defisland
  ~test-runner
  (&key)
  (let
    ((tests (list {:desc "Click button, verify content loads" :actions (list (list :click "button[hx-get]") (list :wait 2000) (list :assert-text "#click-result" :contains "Content loaded!")) :source "(deftest click-to-load\n  (click \"button[hx-get]\")\n  (wait 2000)\n  (assert-text \"#click-result\" :contains \"Content loaded!\"))" :name "click-to-load"} {:desc "OOB sections not in content" :actions (list (list :click "button[hx-get]") (list :wait 2000) (list :assert-text "#click-result" :not-contains "defcomp")) :source "(deftest click-no-oob-leak\n  (click \"button[hx-get]\")\n  (wait 2000)\n  (assert-text \"#click-result\" :not-contains \"defcomp\"))" :name "click-no-oob-leak"} {:desc "Debounced search returns results" :actions (list (list :fill "input[hx-get]" "hx-get") (list :wait 1500) (list :assert-text "#search-results" :contains "GET request")) :source "(deftest search-debounce\n  (fill \"input[hx-get]\" \"hx-get\")\n  (wait 1500)\n  (assert-text \"#search-results\" :contains \"GET request\"))" :name "search-debounce"} {:desc "No match shows empty" :actions (list (list :fill "input[hx-get]" "zzz") (list :wait 1500) (list :assert-text "#search-results" :contains "No results")) :source "(deftest search-no-results\n  (fill \"input[hx-get]\" \"zzz\")\n  (wait 1500)\n  (assert-text \"#search-results\" :contains \"No results\"))" :name "search-no-results"} {:desc "Overview tab loads content" :actions (list (list :click "button[hx-get*='tab=overview']") (list :wait 2000) (list :assert-text "#htmx-tab-content" :contains "htmx gives you access")) :source "(deftest tab-overview\n  (click \"button[hx-get*='tab=overview']\")\n  (wait 2000)\n  (assert-text \"#htmx-tab-content\" :contains \"htmx gives you access\"))" :name "tab-overview"} {:desc "Features tab shows list" :actions (list (list :click "button[hx-get*='tab=features']") (list :wait 2000) (list :assert-text "#htmx-tab-content" :contains "Any element")) :source "(deftest tab-features\n  (click \"button[hx-get*='tab=features']\")\n  (wait 2000)\n  (assert-text \"#htmx-tab-content\" :contains \"Any element\"))" :name "tab-features"} {:desc "POST appends to list" :actions (list (list :click "button[hx-post*='api.append']") (list :wait 2000) (list :assert-count "#item-list > *" :gte 1)) :source "(deftest append-item\n  (click \"button[hx-post*='api.append']\")\n  (wait 2000)\n  (assert-count \"#item-list > *\" :gte 1))" :name "append-item"} {:desc "POST form, verify response" :actions (list (list :fill "form[hx-post] input[name='name']" "Alice") (list :fill "form[hx-post] input[name='email']" "a@b.com") (list :click "form[hx-post] button[type='submit']") (list :wait 2000) (list :assert-text "#form-result" :contains "Alice")) :source "(deftest form-submit\n  (fill name \"Alice\")\n  (click submit)\n  (wait 2000)\n  (assert-text \"#form-result\" :contains \"Alice\"))" :name "form-submit"}))
      (results (signal {}))
      (running (signal false))
      (current (signal "Ready")))
    (letrec
      ((get-doc (fn () (host-get (dom-query "#test-iframe") "contentDocument")))
        (wait-boot
          (fn
            ()
            (let
              ((doc (get-doc)))
              (if
                (and
                  doc
                  (=
                    (dom-get-attr
                      (host-get doc "documentElement")
                      "data-sx-ready")
                    "true"))
                true
                (do (hs-wait 200) (wait-boot))))))
        (reload-frame
          (fn
            ()
            (let
              ((w (host-get (dom-query "#test-iframe") "contentWindow")))
              (host-call (host-get w "location") "reload")
              (hs-wait 1000)
              (wait-boot)
              (console-log "[test] iframe ready, waiting for htmx activation")
              (hs-wait 1500))))
        (wait-for-el
          (fn
            (sel max-tries)
            (let
              ((doc (get-doc))
                (el (when doc (host-call doc "querySelector" sel))))
              (if
                el
                el
                (if
                  (<= max-tries 0)
                  nil
                  (do (hs-wait 200) (wait-for-el sel (- max-tries 1))))))))
        (run-action
          (fn (action)
            (let ((doc (get-doc)) (type (first action)))
              (cond
                (= type :click)
                (let ((el (host-call doc "querySelector" (nth action 1))))
                  (if (nil? el) (str "Not found: " (nth action 1))
                    (do (host-call el "click") nil)))
                (= type :fill)
                (let ((el (host-call doc "querySelector" (nth action 1))))
                  (if (nil? el) (str "Not found: " (nth action 1))
                    (do (host-call el "focus")
                        (dom-set-prop el "value" (nth action 2))
                        (dom-dispatch el "input" nil)
                        (dom-dispatch el "change" nil)
                        nil)))
                (= type :wait)
                (do (hs-wait (nth action 1)) nil)
                (= type :assert-text)
                (let ((el (host-call doc "querySelector" (nth action 1))))
                  (if (nil? el) (str "Not found: " (nth action 1))
                    (let ((txt (dom-text-content el))
                          (kw (nth action 2))
                          (expected (nth action 3)))
                      (cond
                        (and (= kw :contains) (not (contains? txt expected)))
                        (str "Expected '" expected "' in '" (slice txt 0 60) "'")
                        (and (= kw :not-contains) (contains? txt expected))
                        (str "Unexpected '" expected "'")
                        true nil))))
                (= type :assert-count)
                (let ((els (host-call doc "querySelectorAll" (nth action 1))))
                  (let ((count (host-get els "length"))
                        (kw (nth action 2))
                        (expected (nth action 3)))
                    (if (and (= kw :gte) (< count expected))
                      (str "Expected >=" expected " got " count)
                      nil)))
                true nil))))
        (run-all
          (fn
            ()
            (console-log "[test] run-all start")
            (reset! running true)
            (reset! results {:empty true})
            (for-each
              (fn
                (test)
                (let
                  ((name (get test :name)))
                  (console-log (str "[test] === " name " ==="))
                  (reset! current (str "Running: " name))
                  (reset! results (assoc (deref results) name "running"))
                  (console-log "[test] reload-frame")
                  (reload-frame)
                  (console-log "[test] running actions")
                  (let ((actions (get test :actions)) (fail-msg nil))
                    (when (not (empty? actions))
                      (let ((first-sel (nth (first actions) 1)))
                        (when (string? first-sel)
                          (console-log (str "[test] wait-for: " first-sel))
                          (let ((found (wait-for-el first-sel 25)))
                            (when (nil? found) (set! fail-msg (str "Timeout: " first-sel)))))))
                    (when (nil? fail-msg)
                      (for-each (fn (action) (when (nil? fail-msg) (let ((err (run-action action))) (when (string? err) (set! fail-msg err))))) actions))
                    (if (nil? fail-msg)
                      (do (reset! results (assoc (deref results) name "pass")) (console-log (str "[test] PASS " name)))
                      (do (reset! results (assoc (deref results) name "fail")) (console-log (str "[test] FAIL " name ": " fail-msg)))))))
              tests)
            (reset! running false)
            (reset! current "Done")
            (console-log "[test] run-all complete"))))
      (div
        (~tw :tokens "space-y-4")
        (div
          (~tw :tokens "flex items-center gap-4 mb-4")
          (button
            (~tw
              :tokens "px-4 py-2 bg-violet-600 text-white rounded hover:bg-violet-700")
            :on-click (fn (e) (run-all))
            "Run All Tests")
          (span (~tw :tokens "text-sm text-stone-500") (deref current)))
        (div
          (~tw :tokens "space-y-2")
          (when
            tests
            (map
              (fn
                (test)
                (let
                  ((name (get test :name))
                    (status (get (deref results) name)))
                  (details
                    (~tw :tokens "border rounded-lg overflow-hidden")
                    :style (cond
                      (= status "pass")
                      "border-color:#bbf7d0;background:#f0fdf4"
                      (= status "fail")
                      "border-color:#fecaca;background:#fef2f2"
                      (= status "running")
                      "border-color:#c4b5fd"
                      true
                      "border-color:#e7e5e4")
                    (summary
                      (~tw
                        :tokens "px-4 py-2 cursor-pointer hover:bg-stone-50 flex items-center gap-2")
                      (span
                        (~tw :tokens "font-bold")
                        (cond
                          (= status "pass")
                          "✓"
                          (= status "fail")
                          "✗"
                          (= status "running")
                          "⟳"
                          true
                          "○"))
                      (span (~tw :tokens "font-medium") name)
                      (span
                        (~tw :tokens "text-sm text-stone-400 ml-auto")
                        (get test :desc)))
                    (div
                      (~tw
                        :tokens "px-4 py-3 bg-stone-50 border-t border-stone-200")
                      (pre
                        (~tw
                          :tokens "text-xs font-mono whitespace-pre-wrap text-stone-600")
                        (get test :source))))))
              tests)))
        (iframe
          :id "test-iframe"
          :src "/sx/(applications.(htmx))"
          (~tw :tokens "w-full border border-stone-200 rounded-lg mt-4")
          :style "height:600px")))))

;; Page component — passes test definitions to the island
(defcomp
  ()
  (~docs/page
    :title "Test: htmx demos"
    (p
      (~tw :tokens "text-stone-500 mb-4")
      "Running tests against "
      (a
        :href "/sx/(applications.(htmx))"
        (~tw :tokens "text-violet-600 underline")
        "/sx/(applications.(htmx))"))
    (~test-runner)))