(ns glimmer-jvui.tests
  "Every check here runs headless: no window, no SDL, no font, no display.

   jvui takes its measurer as a function, so the whole stack — glimmer's
   reconciler, this backend's walk, jvui's layout and event routing — can be
   driven with a stub that says eight pixels a character. `jolt test`."
  (:require [glimmer.ratom :as ra]
            [glimmer.core :as gui]
            [glimmer-jvui.core :as jv]
            [jvui.core :as c]))

(def ^:private failures (atom 0))

(defn- check! [ok? msg]
  (when-not ok?
    (swap! failures inc)
    (println "  FAIL:" msg)))

(defn- ctx []
  (c/context {:size [400 300]
              :measure (fn [s _] [(* 8.0 (count s)) 16.0])
              :line-height (fn [_] 16.0)}))

(defn- walk [n] (cons n (mapcat walk (:children @n))))
(defn- tagged [root tag] (first (filter #(= tag (:tag @%)) (walk root))))
(defn- labels [root]
  (map #(str (:label (:props @%)))
       (filter #(= :label (:tag @%)) (walk root))))

(defn- centre
  "The middle of the rectangle jvui gave this node on the last walk."
  [n]
  (let [[x y w h] (:rect @n)] [(+ x (/ w 2.0)) (+ y (/ h 2.0))]))

(defn- click-at [x y]
  [{:kind :motion :x x :y y}
   {:kind :mouse-down :x x :y y :button 1 :clicks 1}
   {:kind :mouse-up :x x :y y :button 1}])

;; --- the reconciler reaches the backend --------------------------------------

(def ^:private clicks (ra/atom 0))
(def ^:private on? (ra/atom false))

(defn- app []
  [:card {}
   [:title {:label "Counter"}]
   [:label {:label (str "Count: " (ra/deref clicks))}]
   [:button {:label "+1" :kind :primary :on-click #(ra/swap! clicks inc)}]
   [:checkbox {:label "loud" :checked (ra/deref on?)
               :on-change #(ra/reset! on? %)}]])

(defn- check-tree! []
  (let [root (jv/root-node)]
    (gui/mount root :page [app])
    (check! (some? (tagged root :card)) "the reconciler built a card")
    (check! (some? (tagged root :button)) "and a button")
    (check! (some #{"Count: 0"} (labels root))
            "and a label that read the ratom")))

(defn- check-walk-places-widgets! []
  (let [root (jv/root-node) cx (ctx)]
    (gui/mount root :page [app])
    (jv/render-once root cx)
    (let [placed (vals (:data @cx))
          card (first (filter #(and (:rect %) (> (first (:min-size % [0 0])) 100))
                              placed))]
      (check! (some? card) "the walk placed a container with a rectangle")
      (check! (every? (fn [[_ _ w h]] (and (>= w 0) (>= h 0)))
                      (keep :rect placed))
              "and no rectangle came out negative"))))

;; --- a click goes all the way round ------------------------------------------

(defn- check-click-fires-the-handler! []
  (let [root (jv/root-node) cx (ctx)]
    (ra/reset! clicks 0)
    (gui/mount root :page [app])
    (jv/render-once root cx)
    (jv/render-once root cx)
    (let [before (ra/deref clicks)
          [bx by] (centre (tagged root :button))]
      (jv/render-once root cx (click-at bx by))
      (check! (= (inc before) (ra/deref clicks))
              (str "the click reached :on-click (" before " -> "
                   (ra/deref clicks) ")"))
      (jv/render-once root cx)
      (check! (some #{(str "Count: " (ra/deref clicks))} (labels root))
              "and the reactive re-render reached the tree"))))

(defn- check-press-alone-is-not-a-click! []
  (let [root (jv/root-node) cx (ctx)]
    (ra/reset! clicks 0)
    (gui/mount root :page [app])
    (jv/render-once root cx)
    (jv/render-once root cx)
    (let [[bx by] (centre (tagged root :button))]
      (jv/render-once root cx [{:kind :motion :x bx :y by}
                               {:kind :mouse-down :x bx :y by :button 1 :clicks 1}]))
    (check! (zero? (ra/deref clicks)) "a press alone must not fire the handler")
    (jv/render-once root cx [{:kind :motion :x 390 :y 290}
                             {:kind :mouse-up :x 390 :y 290 :button 1}])
    (check! (zero? (ra/deref clicks)) "and releasing off it must not either")))

;; --- identity follows the node, not its index --------------------------------

(defn- check-reorder-keeps-identity! []
  ;; The reason every node carries a serial as its jvui key. Render a list,
  ;; reorder it, and the ids the walk hands out must travel with the nodes.
  (let [root (jv/root-node) cx (ctx)
        items (ra/atom [:a :b :c])
        list-app (fn []
                   (into [:vbox {}]
                         (for [k (ra/deref items)]
                           ^{:key k} [:button {:label (name k)}])))
        ids (fn [] (into {} (map (fn [n] [(:label (:props @n)) (:key @n)])
                                 (filter #(= :button (:tag @%)) (walk root)))))]
    (gui/mount root :page [list-app])
    (jv/render-once root cx)
    (let [before (ids)]
      (ra/reset! items [:c :a :b])
      (jv/render-once root cx)
      (let [after (ids)]
        (check! (= 3 (count after)) "the list still has three buttons")
        (check! (= (get before "a") (get after "a"))
                "a keyed node keeps its jvui key across a reorder")
        (check! (= (get before "c") (get after "c"))
                "including the one that moved to the front")))))

;; --- the vocabulary ----------------------------------------------------------

(defn- check-unknown-tag-is-a-container! []
  (let [root (jv/root-node) cx (ctx)]
    (gui/mount root :page [(fn [] [:flerb {} [:label {:label "inside"}]])])
    (jv/render-once root cx)
    (check! (some #{"inside"} (labels root))
            "an unknown tag shows its contents rather than raising")))

(defn- check-entry-round-trips! []
  (let [root (jv/root-node) cx (ctx)
        text (ra/atom "")]
    (gui/mount root :page
               [(fn [] [:entry {:value (ra/deref text)
                                :on-change #(ra/reset! text %)}])])
    (jv/render-once root cx)
    (let [[ex ey] (centre (tagged root :entry))]
      (jv/render-once root cx (click-at ex ey)))       ; take focus
    (jv/render-once root cx [{:kind :text :text "hi"}])
    (check! (= "hi" (ra/deref text))
            (str "typed text reached :on-change: " (pr-str (ra/deref text))))))

(defn- check-checkbox-round-trips! []
  (let [root (jv/root-node) cx (ctx)]
    (ra/reset! on? false)
    (gui/mount root :page [app])
    (jv/render-once root cx)
    (jv/render-once root cx)
    (let [[bx by] (centre (tagged root :checkbox))]
      (jv/render-once root cx (click-at bx by)))
    (check! (true? (ra/deref on?))
            (str "the checkbox reached :on-change: " (ra/deref on?)))))

;; --- runner ------------------------------------------------------------------

(def ^:private checks
  [["the reconciler builds a tree"  check-tree!]
   ["the walk places widgets"       check-walk-places-widgets!]
   ["a click fires the handler"     check-click-fires-the-handler!]
   ["a press alone does not"        check-press-alone-is-not-a-click!]
   ["a reorder keeps identity"      check-reorder-keeps-identity!]
   ["an unknown tag is a container" check-unknown-tag-is-a-container!]
   ["an entry round-trips"          check-entry-round-trips!]
   ["a checkbox round-trips"        check-checkbox-round-trips!]])

(defn -main [& _]
  (doseq [[name f] checks]
    (println "-" name)
    (f))
  (if (zero? @failures)
    (println "\nall" (count checks) "checks passed")
    (do (println "\n" @failures "failed") (System/exit 1))))