rose-ash/web/harness-web.sx

;; ==========================================================================
;; web/harness-web.sx — Web platform testing extensions
;;
;; Extends spec/harness.sx with DOM mocking, event simulation, and
;; web-specific assertions. Depends on web/signals.sx for reactive features.
;;
;; Mock DOM: lightweight element stubs that record operations.
;; No real browser needed — runs on any host.
;; ==========================================================================


;; --------------------------------------------------------------------------
;; Mock DOM elements
;; --------------------------------------------------------------------------

;; Create a mock element with tag name, attrs dict, children list, and event log
(define mock-element :effects []
  (fn ((tag :as string) &key class id)
    {:tag tag
     :attrs (merge {} (if class {:class class} {}) (if id {:id id} {}))
     :children (list)
     :text ""
     :event-log (list)
     :listeners {}}))

;; Set text content on mock element
(define mock-set-text! :effects [mutation]
  (fn (el (text :as string))
    (dict-set! el "text" text)))

;; Append child to mock element
(define mock-append-child! :effects [mutation]
  (fn (parent child)
    (append! (get parent "children") child)))

;; Set attribute on mock element
(define mock-set-attr! :effects [mutation]
  (fn (el (name :as string) value)
    (dict-set! (get el "attrs") name value)))

;; Get attribute from mock element
(define mock-get-attr :effects []
  (fn (el (name :as string))
    (get (get el "attrs") name)))

;; Add event listener to mock element
(define mock-add-listener! :effects [mutation]
  (fn (el (event-name :as string) (handler :as lambda))
    (let ((listeners (get el "listeners")))
      (when (not (has-key? listeners event-name))
        (dict-set! listeners event-name (list)))
      (append! (get listeners event-name) handler))))


;; --------------------------------------------------------------------------
;; Event simulation
;; --------------------------------------------------------------------------

;; Simulate a click event on a mock element
(define simulate-click :effects [mutation]
  (fn (el)
    (let ((handlers (get (get el "listeners") "click")))
      (when handlers
        (for-each (fn (h) (cek-call h (list {:type "click" :target el})))
          handlers))
      (append! (get el "event-log") {:type "click"}))))

;; Simulate an input event with a value
(define simulate-input :effects [mutation]
  (fn (el (value :as string))
    (mock-set-attr! el "value" value)
    (let ((handlers (get (get el "listeners") "input")))
      (when handlers
        (for-each (fn (h) (cek-call h (list {:type "input" :target el})))
          handlers))
      (append! (get el "event-log") {:type "input" :value value}))))

;; Simulate a custom event (for lake→island bridge)
(define simulate-event :effects [mutation]
  (fn (el (event-name :as string) detail)
    (let ((handlers (get (get el "listeners") event-name)))
      (when handlers
        (for-each (fn (h) (cek-call h (list {:type event-name :detail detail :target el})))
          handlers))
      (append! (get el "event-log") {:type event-name :detail detail}))))


;; --------------------------------------------------------------------------
;; DOM assertions
;; --------------------------------------------------------------------------

;; Assert mock element has specific text content
(define assert-text :effects []
  (fn (el (expected :as string))
    (let ((actual (get el "text")))
      (assert= actual expected
        (str "Expected text \"" expected "\", got \"" actual "\"")))))

;; Assert mock element has an attribute with expected value
(define assert-attr :effects []
  (fn (el (name :as string) expected)
    (let ((actual (mock-get-attr el name)))
      (assert= actual expected
        (str "Expected attr " name "=\"" expected "\", got \"" actual "\"")))))

;; Assert mock element has a CSS class
(define assert-class :effects []
  (fn (el (class-name :as string))
    (let ((classes (or (mock-get-attr el "class") "")))
      (assert (contains? (split classes " ") class-name)
        (str "Expected class \"" class-name "\" in \"" classes "\"")))))

;; Assert mock element does NOT have a CSS class
(define assert-no-class :effects []
  (fn (el (class-name :as string))
    (let ((classes (or (mock-get-attr el "class") "")))
      (assert (not (contains? (split classes " ") class-name))
        (str "Expected no class \"" class-name "\" but found in \"" classes "\"")))))

;; Assert mock element has N children
(define assert-child-count :effects []
  (fn (el (n :as number))
    (let ((actual (len (get el "children"))))
      (assert= actual n
        (str "Expected " n " children, got " actual)))))

;; Assert an event was fired on mock element
(define assert-event-fired :effects []
  (fn (el (event-name :as string))
    (assert (some (fn (e) (= (get e "type") event-name)) (get el "event-log"))
      (str "Expected event \"" event-name "\" to have been fired"))))

;; Assert an event was NOT fired on mock element
(define assert-no-event :effects []
  (fn (el (event-name :as string))
    (assert (not (some (fn (e) (= (get e "type") event-name)) (get el "event-log")))
      (str "Expected event \"" event-name "\" to NOT have been fired"))))

;; Count how many times an event was fired
(define event-fire-count :effects []
  (fn (el (event-name :as string))
    (len (filter (fn (e) (= (get e "type") event-name)) (get el "event-log")))))


;; --------------------------------------------------------------------------
;; Web harness constructor — extends make-harness with DOM mock state
;; --------------------------------------------------------------------------

(define make-web-harness :effects []
  (fn (&key platform)
    (let ((h (make-harness :platform platform)))
      (harness-set! h "dom" {:root (mock-element "div" :id "root")
                             :elements {}})
      h)))