(define
  mock-element
  :effects ()
  (fn ((tag :as string) &key class id) {:children (list) :listeners {} :event-log (list) :tag tag :text "" :attrs (merge {} (if class {:class class} {}) (if id {:id id} {}))}))

(define
  mock-set-text!
  :effects (mutation)
  (fn (el (text :as string)) (dict-set! el "text" text)))

(define
  mock-append-child!
  :effects (mutation)
  (fn (parent child) (append! (get parent "children") child)))

(define
  mock-set-attr!
  :effects (mutation)
  (fn (el (name :as string) value) (dict-set! (get el "attrs") name value)))

(define
  mock-get-attr
  :effects ()
  (fn (el (name :as string)) (get (get el "attrs") name)))

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

(define
  simulate-click
  :effects (mutation)
  (fn
    (el)
    (let
      ((handlers (get (get el "listeners") "click")))
      (when
        handlers
        (for-each (fn (h) (cek-call h (list {:target el :type "click"}))) handlers))
      (append! (get el "event-log") {:type "click"}))))

(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 {:target el :type "input"}))) handlers))
      (append! (get el "event-log") {:value value :type "input"}))))

(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 {:target el :detail detail :type event-name}))) handlers))
      (append! (get el "event-log") {:detail detail :type event-name}))))

(define
  assert-text
  :effects ()
  (fn
    (el (expected :as string))
    (let
      ((actual (get el "text")))
      (assert=
        actual
        expected
        (str "Expected text \"" expected "\", got \"" actual "\"")))))

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

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

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

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

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

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

(define
  event-fire-count
  :effects ()
  (fn
    (el (event-name :as string))
    (len
      (filter (fn (e) (= (get e "type") event-name)) (get el "event-log")))))

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

(define
  is-renderable?
  :effects ()
  (fn
    (value)
    (cond
      (nil? value)
      true
      (string? value)
      true
      (number? value)
      true
      (boolean? value)
      true
      (dict? value)
      false
      (not (list? value))
      false
      (empty? value)
      true
      :else (let
        ((head (first value)))
        (and (= (type-of head) "symbol") (not (dict? head)))))))

(define
  is-render-leak?
  :effects ()
  (fn (value) (and (not (nil? value)) (not (is-renderable? value)))))

(define
  assert-renderable
  :effects ()
  (fn
    (value label)
    (assert
      (is-renderable? value)
      (str
        "Render leak in "
        label
        ": "
        (type-of value)
        (cond
          (dict? value)
          " — dict would appear as {:key val} text in output"
          (and (list? value) (not (empty? value)) (dict? (first value)))
          " — list of dicts would appear as raw data in output"
          :else " — non-renderable value would appear as text")))))

(define
  render-body-audit
  :effects ()
  (fn
    (values)
    (let
      ((leaks (list)))
      (for-each
        (fn (v) (when (is-render-leak? v) (append! leaks {:leak-kind (cond (dict? v) "dict" (and (list? v) (not (empty? v)) (dict? (first v))) "list-of-dicts" :else "other") :value-type (type-of v)})))
        values)
      leaks)))

(define
  assert-render-body-clean
  :effects ()
  (fn
    (values label)
    (let
      ((leaks (render-body-audit values)))
      (assert
        (empty? leaks)
        (str
          "Render body has "
          (len leaks)
          " leak(s) in "
          label
          ". "
          "render-to-html/render-to-dom render ALL body expressions — "
          "put side effects in let bindings, not body expressions.")))))

(define
  mock-render
  :effects (mutation)
  (fn
    (expr)
    (cond
      (nil? expr)
      nil
      (string? expr)
      (let ((el (mock-element "TEXT"))) (mock-set-text! el expr) el)
      (number? expr)
      (let ((el (mock-element "TEXT"))) (mock-set-text! el (str expr)) el)
      (not (list? expr))
      nil
      (empty? expr)
      nil
      :else (let
        ((head (first expr)))
        (if
          (not (= (type-of head) "symbol"))
          nil
          (let
            ((el (mock-element (symbol-name head))))
            (let
              loop
              ((args (rest expr)))
              (when
                (not (empty? args))
                (let
                  ((arg (first args)))
                  (if
                    (= (type-of arg) "keyword")
                    (when
                      (not (empty? (rest args)))
                      (mock-set-attr! el (keyword-name arg) (nth args 1))
                      (loop (rest (rest args))))
                    (do
                      (let
                        ((child-el (mock-render arg)))
                        (when child-el (mock-append-child! el child-el)))
                      (loop (rest args)))))))
            el))))))

(define
  mock-render-fragment
  :effects (mutation)
  (fn
    (exprs)
    (filter (fn (el) (not (nil? el))) (map mock-render exprs))))

(define
  assert-single-render-root
  :effects ()
  (fn
    (exprs label)
    (let
      ((rendered (mock-render-fragment exprs)))
      (assert
        (= (len rendered) 1)
        (str
          "Expected single render root in "
          label
          " but got "
          (len rendered)
          " element(s). "
          "Multi-body let/begin in render-to-html/render-to-dom renders "
          "ALL expressions — put side effects in let bindings.")))))

(define
  assert-tag
  :effects ()
  (fn
    (el expected-tag)
    (assert
      (= (get el "tag") expected-tag)
      (str "Expected <" expected-tag "> but got <" (get el "tag") ">"))))