;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC Sucursal en España SL

(ns frontend-tests.plugins.context-shapes-test
  (:require
   [app.common.math :as m]
   [app.common.test-helpers.files :as cthf]
   [app.common.uuid :as uuid]
   [app.main.data.workspace.reflow :as wrf]
   [app.main.data.workspace.shapes :as dwsh]
   [app.main.data.workspace.texts :as dwtxt]
   [app.main.data.workspace.wasm-text :as dwwt]
   [app.main.store :as st]
   [app.plugins.api :as api]
   [app.plugins.reflow :as pwrf]
   [app.plugins.shape :as shape]
   [app.util.object :as obj]
   [beicon.v2.core :as rx]
   [cljs.test :as t :include-macros true]
   [frontend-tests.helpers.state :as ths]
   [frontend-tests.helpers.wasm :as thw]
   [potok.v2.core :as ptk]))

(t/deftest test-common-shape-properties
  (thw/with-wasm-mocks*
    (fn []
      (let [;; ==== Setup
            store   (ths/setup-store (cthf/sample-file :file1 :page-label :page1))

            ^js context (api/create-context "00000000-0000-0000-0000-000000000000")

            _       (set! st/state store)
            _       (ptk/emit! store #(assoc-in % [:plugins :flags "00000000-0000-0000-0000-000000000000" :throw-validation-errors] true))

            ^js file    (. context -currentFile)
            ^js page    (. context -currentPage)
            ^js shape   (.createRectangle context)

            get-shape-path
            #(vector :files (aget file "$id") :data :pages-index (aget page "$id") :objects (aget shape "$id") %)

            gradient
            (fn []
              #js {:type "linear"
                   :startX 0.5
                   :startY 0
                   :endX 0.5
                   :endY 1
                   :width 1
                   :stops #js [#js {:color "#b400ff" :opacity 1 :offset 0}
                               #js {:color "#0c3fd5" :opacity 1 :offset 1}]})

            parsed-gradient
            {:type :linear
             :start-x 0.5
             :start-y 0
             :end-x 0.5
             :end-y 1
             :width 1
             :stops [{:color "#b400ff" :opacity 1 :offset 0}
                     {:color "#0c3fd5" :opacity 1 :offset 1}]}]

        (t/testing "Basic shape properties"
          (t/testing " - name"
            (set! (.-name shape) "TEST")
            (t/is (= (.-name shape) "TEST"))
            (t/is (= (get-in @store (get-shape-path :name)) "TEST")))

          (t/testing " - x"
            (set! (.-x shape) 10)
            (t/is (= (.-x shape) 10))
            (t/is (= (get-in @store (get-shape-path :x)) 10))

            (t/is (thrown? js/Error (set! (.-x shape) "fail")))
            (t/is (= (.-x shape) 10))
            (t/is (= (get-in @store (get-shape-path :x)) 10)))

          (t/testing " - y"
            (set! (.-y shape) 50)
            (t/is (= (.-y shape) 50))
            (t/is (= (get-in @store (get-shape-path :y)) 50))

            (t/is (thrown? js/Error (set! (.-y shape) "fail")))
            (t/is (= (.-y shape) 50))
            (t/is (= (get-in @store (get-shape-path :y)) 50)))

          (t/testing " - resize"
            (.resize shape 250 300)
            (t/is (= (.-width shape) 250))
            (t/is (= (.-height shape) 300))
            (t/is (= (get-in @store (get-shape-path :width)) 250))
            (t/is (= (get-in @store (get-shape-path :height)) 300))

            (t/is (thrown? js/Error (.resize shape 0 0)))
            (t/is (= (.-width shape) 250))
            (t/is (= (.-height shape) 300))
            (t/is (= (get-in @store (get-shape-path :width)) 250))
            (t/is (= (get-in @store (get-shape-path :height)) 300)))

          (t/testing " - blocked"
            (set! (.-blocked shape) true)
            (t/is (= (.-blocked shape) true))
            (t/is (= (get-in @store (get-shape-path :blocked)) true))

            (set! (.-blocked shape) false)
            (t/is (= (.-blocked shape) false))
            (t/is (= (get-in @store (get-shape-path :blocked)) false)))

          (t/testing " - hidden"
            (set! (.-hidden shape) true)
            (t/is (= (.-hidden shape) true))
            (t/is (= (get-in @store (get-shape-path :hidden)) true))

            (set! (.-hidden shape) false)
            (t/is (= (.-hidden shape) false))
            (t/is (= (get-in @store (get-shape-path :hidden)) false)))

          (t/testing " - proportionLock"
            (set! (.-proportionLock shape) true)
            (t/is (= (.-proportionLock shape) true))
            (t/is (= (get-in @store (get-shape-path :proportion-lock)) true)))

          (t/testing " - constraintsHorizontal"
            (t/is (thrown? js/Error (set! (.-constraintsHorizontal shape) "fail")))
            (t/is (not= (.-constraintsHorizontal shape) "fail"))
            (t/is (not= (get-in @store (get-shape-path :constraints-h)) "fail"))

            (set! (.-constraintsHorizontal shape) "right")
            (t/is (= (.-constraintsHorizontal shape) "right"))
            (t/is (= (get-in @store (get-shape-path :constraints-h)) :right)))

          (t/testing " - constraintsVertical"
            (t/is (thrown? js/Error (set! (.-constraintsVertical shape) "fail")))
            (t/is (not= (.-constraintsVertical shape) "fail"))
            (t/is (not= (get-in @store (get-shape-path :constraints-v)) "fail"))

            (set! (.-constraintsVertical shape) "bottom")
            (t/is (= (.-constraintsVertical shape) "bottom"))
            (t/is (= (get-in @store (get-shape-path :constraints-v)) :bottom)))

          (t/testing " - fixedWhenScrolling"
            (set! (.-fixedWhenScrolling shape) true)
            (t/is (= (.-fixedWhenScrolling shape) true))
            (t/is (= (get-in @store (get-shape-path :fixed-scroll)) true))

            (set! (.-fixedWhenScrolling shape) false)
            (t/is (= (.-fixedWhenScrolling shape) false))
            (t/is (= (get-in @store (get-shape-path :fixed-scroll)) false)))

          (t/testing " - borderRadius"
            (set! (.-borderRadius shape) 10)
            (t/is (= (.-borderRadius shape) 10))
            (t/is (= (get-in @store (get-shape-path :r1)) 10))

            (set! (.-borderRadiusTopLeft shape) 20)
            (t/is (= (.-borderRadiusTopLeft shape) 20))
            (t/is (= (get-in @store (get-shape-path :r1)) 20))
            (t/is (= (get-in @store (get-shape-path :r2)) 10))
            (t/is (= (get-in @store (get-shape-path :r3)) 10))
            (t/is (= (get-in @store (get-shape-path :r4)) 10))

            (set! (.-borderRadiusTopRight shape) 30)
            (set! (.-borderRadiusBottomRight shape) 40)
            (set! (.-borderRadiusBottomLeft shape) 50)
            (t/is (= (.-borderRadiusTopRight shape) 30))
            (t/is (= (.-borderRadiusBottomRight shape) 40))
            (t/is (= (.-borderRadiusBottomLeft shape) 50))

            (t/is (= (get-in @store (get-shape-path :r1)) 20))
            (t/is (= (get-in @store (get-shape-path :r2)) 30))
            (t/is (= (get-in @store (get-shape-path :r3)) 40))
            (t/is (= (get-in @store (get-shape-path :r4)) 50)))

          (t/testing " - opacity"
            (set! (.-opacity shape) 0.5)
            (t/is (= (.-opacity shape) 0.5))
            (t/is (= (get-in @store (get-shape-path :opacity)) 0.5)))

          (t/testing " - blendMode"
            (set! (.-blendMode shape) "multiply")
            (t/is (= (.-blendMode shape) "multiply"))
            (t/is (= (get-in @store (get-shape-path :blend-mode)) :multiply))

            (t/is (thrown? js/Error (set! (.-blendMode shape) "fail")))
            (t/is (= (.-blendMode shape) "multiply"))
            (t/is (= (get-in @store (get-shape-path :blend-mode)) :multiply)))

          (t/testing " - shadows"
            (let [shadow #js {:style "drop-shadow"
                              :color #js {:color "#FABADA" :opacity 1}}]
              (set! (.-shadows shape) #js [shadow])
              (let [shadow-id (uuid/uuid (aget (aget (aget shape "shadows") 0) "id"))]
                (t/is (= (-> (. shape -shadows) (aget 0) (aget "style")) "drop-shadow"))
                (t/is (= (get-in @store (get-shape-path :shadow)) [{:id shadow-id
                                                                    :style :drop-shadow
                                                                    :offset-x 4
                                                                    :offset-y 4
                                                                    :blur 4
                                                                    :spread 0
                                                                    :color {:color "#fabada" :opacity 1}
                                                                    :hidden false}]))))
            (let [shadow #js {:style "fail"}]
              (t/is (thrown? js/Error (set! (.-shadows shape) #js [shadow])))
              (t/is (= (-> (. shape -shadows) (aget 0) (aget "style")) "drop-shadow"))))

          (t/testing " - blur"
            (set! (.-blur shape) #js {:value 10})
            (t/is (= (-> (. shape -blur) (aget "value")) 10))
            (t/is (= (-> (. shape -blur) (aget "hidden")) false))
            (let [id (-> (. shape -blur) (aget "id") uuid/uuid)]
              (t/is (= (get-in @store (get-shape-path :blur)) {:id id :type :layer-blur :value 10 :hidden false}))))

          (t/testing " - exports"
            (set! (.-exports shape) #js [#js {:type "pdf" :scale 2 :suffix "test"}])
            (t/is (= (-> (. shape -exports) (aget 0) (aget "type")) "pdf"))
            (t/is (= (-> (. shape -exports) (aget 0) (aget "scale")) 2))
            (t/is (= (-> (. shape -exports) (aget 0) (aget "suffix")) "test"))
            (t/is (= (get-in @store (get-shape-path :exports)) [{:type :pdf :scale 2 :suffix "test" :skip-children false}]))

            (t/is (thrown? js/Error (set! (.-exports shape) #js [#js {:type 10 :scale 2 :suffix "test"}])))
            (t/is (= (get-in @store (get-shape-path :exports)) [{:type :pdf :scale 2 :suffix "test" :skip-children false}])))

          (t/testing " - flipX"
            (set! (.-flipX shape) true)
            (t/is (= (.-flipX shape) true))
            (t/is (= (get-in @store (get-shape-path :flip-x)) true)))

          (t/testing " - flipY"
            (set! (.-flipY shape) true)
            (t/is (= (.-flipY shape) true))
            (t/is (= (get-in @store (get-shape-path :flip-y)) true)))

          (t/testing " - rotation"
            (set! (.-rotation shape) 45)
            (t/is (= (.-rotation shape) 45))
            (t/is (= (get-in @store (get-shape-path :rotation)) 45))

            (set! (.-rotation shape) 0)
            (t/is (= (.-rotation shape) 0))
            (t/is (= (get-in @store (get-shape-path :rotation)) 0)))

          (t/testing " - fills"
            (t/is (thrown? js/Error (set! (.-fills shape) #js [#js {:fillColor 100}])))
            (t/is (= (get-in @store (get-shape-path :fills)) [{:fill-color "#B1B2B5" :fill-opacity 1}]))
            (t/is (= (-> (. shape -fills) (aget 0) (aget "fillColor")) "#B1B2B5"))

            (set! (.-fills shape) #js [#js {:fillColor "#fabada" :fillOpacity 1}])
            (t/is (= (get-in @store (get-shape-path :fills)) [{:fill-color "#fabada" :fill-opacity 1}]))
            (t/is (= (-> (. shape -fills) (aget 0) (aget "fillColor")) "#fabada"))
            (t/is (= (-> (. shape -fills) (aget 0) (aget "fillOpacity")) 1)))

          (t/testing " - strokes"
            (set! (.-strokes shape) #js [#js {:strokeColor "#fabada" :strokeOpacity 1 :strokeWidth 5}])
            (t/is (= (get-in @store (get-shape-path :strokes)) [{:stroke-color "#fabada" :stroke-opacity 1 :stroke-width 5}]))
            (t/is (= (-> (. ^js shape -strokes) (aget 0) (aget "strokeColor")) "#fabada"))
            (t/is (= (-> (. ^js shape -strokes) (aget 0) (aget "strokeOpacity")) 1))
            (t/is (= (-> (. ^js shape -strokes) (aget 0) (aget "strokeWidth")) 5)))

          (t/testing " - fills per-element property mutation (bug #8357)"
            (set! (.-fills shape) #js [#js {:fillColor "#fabada" :fillOpacity 1}])
            (obj/set! (aget (.-fills shape) 0) "fillColor" "#ff0000")
            (t/is (= (get-in @store (get-shape-path :fills)) [{:fill-color "#ff0000" :fill-opacity 1}]))
            (t/is (= (-> (. shape -fills) (aget 0) (aget "fillColor")) "#ff0000")))

          (t/testing " - fills gradient assignment replaces solid color (bug #8357)"
            (set! (.-fills shape) #js [#js {:fillColor "#fabada" :fillOpacity 1}])
            (obj/set! (aget (.-fills shape) 0) "fillColorGradient" (gradient))
            (t/is (= (get-in @store (get-shape-path :fills))
                     [{:fill-opacity 1 :fill-color-gradient parsed-gradient}]))
            (t/is (nil? (-> (. shape -fills) (aget 0) (aget "fillColor")))))

          (t/testing " - fills nested gradient mutation (bug #8357)"
            (set! (.-fills shape) #js [#js {:fillColorGradient (gradient) :fillOpacity 1}])
            (let [fill-gradient (-> (. shape -fills) (aget 0) (aget "fillColorGradient"))
                  stop          (-> fill-gradient (aget "stops") (aget 0))]
              (obj/set! fill-gradient "startX" 0.25)
              (obj/set! stop "color" "#ffffff")
              (t/is (= (get-in @store (get-shape-path :fills))
                       [{:fill-opacity 1
                         :fill-color-gradient (-> parsed-gradient
                                                  (assoc :start-x 0.25)
                                                  (assoc-in [:stops 0 :color] "#ffffff"))}]))))

          (t/testing " - strokes per-element property mutation (bug #8357)"
            (set! (.-strokes shape) #js [#js {:strokeColor "#fabada" :strokeOpacity 1 :strokeWidth 5}])
            (obj/set! (aget (.-strokes shape) 0) "strokeColor" "#0000ff")
            (t/is (= (get-in @store (get-shape-path :strokes)) [{:stroke-color "#0000ff" :stroke-opacity 1 :stroke-width 5}])))

          (t/testing " - strokes gradient assignment replaces solid color (bug #8357)"
            (set! (.-strokes shape) #js [#js {:strokeColor "#fabada" :strokeOpacity 1 :strokeWidth 5}])
            (obj/set! (aget (.-strokes shape) 0) "strokeColorGradient" (gradient))
            (t/is (= (get-in @store (get-shape-path :strokes))
                     [{:stroke-opacity 1 :stroke-width 5 :stroke-color-gradient parsed-gradient}])))

          (t/testing " - strokes nested gradient mutation (bug #8357)"
            (set! (.-strokes shape) #js [#js {:strokeColorGradient (gradient) :strokeOpacity 1 :strokeWidth 5}])
            (let [stroke-gradient (-> (. shape -strokes) (aget 0) (aget "strokeColorGradient"))
                  stop            (-> stroke-gradient (aget "stops") (aget 1))]
              (obj/set! stroke-gradient "endY" 0.75)
              (obj/set! stop "opacity" 0.25)
              (t/is (= (get-in @store (get-shape-path :strokes))
                       [{:stroke-opacity 1
                         :stroke-width 5
                         :stroke-color-gradient (-> parsed-gradient
                                                    (assoc :end-y 0.75)
                                                    (assoc-in [:stops 1 :opacity] 0.25))}])))))

        (t/testing "Text shape fills"
          (let [^js text (.createText context "Hello")]

            (t/testing " - flat fill set and read-back"
              (set! (.-fills text) #js [#js {:fillColor "#aa00aa" :fillOpacity 0.9}])
              (t/is (= (-> (. text -fills) (aget 0) (aget "fillColor")) "#aa00aa"))
              (t/is (= (-> (. text -fills) (aget 0) (aget "fillOpacity")) 0.9)))

            (t/testing " - in-place fill color mutation"
              (set! (.-fills text) #js [#js {:fillColor "#fabada" :fillOpacity 1}])
              (obj/set! (aget (.-fills text) 0) "fillColor" "#00ccdd")
              (obj/set! (aget (.-fills text) 0) "fillOpacity" 0.5)
              (t/is (= (-> (. text -fills) (aget 0) (aget "fillColor")) "#00ccdd"))
              (t/is (= (-> (. text -fills) (aget 0) (aget "fillOpacity")) 0.5)))

            (t/testing " - gradient fill set"
              (set! (.-fills text) #js [#js {:fillColorGradient (gradient) :fillOpacity 1}])
              (let [g (-> (. text -fills) (aget 0) (aget "fillColorGradient"))]
                (t/is (= (aget g "type") "linear"))
                (t/is (= (-> g (aget "stops") (aget 0) (aget "color")) "#b400ff"))
                (t/is (= (-> g (aget "stops") (aget 1) (aget "color")) "#0c3fd5"))))

            (t/testing " - gradient stop mutation"
              (set! (.-fills text) #js [#js {:fillColorGradient (gradient) :fillOpacity 1}])
              (let [fill-gradient (-> (. text -fills) (aget 0) (aget "fillColorGradient"))
                    stop          (-> fill-gradient (aget "stops") (aget 0))]
                (obj/set! fill-gradient "startX" 0.1)
                (obj/set! stop "color" "#ffff00")
                (obj/set! stop "opacity" 0.5)
                (let [g2 (-> (. text -fills) (aget 0) (aget "fillColorGradient"))]
                  (t/is (= (aget g2 "startX") 0.1))
                  (t/is (= (-> g2 (aget "stops") (aget 0) (aget "color")) "#ffff00"))
                  (t/is (= (-> g2 (aget "stops") (aget 0) (aget "opacity")) 0.5)))))

            (t/testing " - fillColor clears fillColorGradient"
              (set! (.-fills text) #js [#js {:fillColorGradient (gradient) :fillOpacity 1}])
              (obj/set! (aget (.-fills text) 0) "fillColor" "#123456")
              (t/is (= (-> (. text -fills) (aget 0) (aget "fillColor")) "#123456"))
              (t/is (nil? (-> (. text -fills) (aget 0) (aget "fillColorGradient")))))))

        (t/testing "createText with empty string returns null"
          (t/is (nil? (.createText context "")))
          (t/is (some? (.createText context "Hello"))))

        (t/testing "Relative properties"
          (let [board (.createBoard context)]
            (set! (.-x board) 100)
            (set! (.-y board) 200)
            (t/is (= (.-x board) 100))
            (t/is (= (.-y board) 200))
            (.appendChild board shape)

            (t/testing " - boardX"
              (set! (.-boardX ^js shape) 10)
              (t/is (m/close? (.-boardX ^js shape) 10))
              (t/is (m/close? (.-x shape) 110))
              (t/is (m/close? (get-in @store (get-shape-path :x)) 110)))

            (t/testing " - boardY"
              (set! (.-boardY ^js shape) 20)
              (t/is (m/close? (.-boardY  ^js shape) 20))
              (t/is (m/close? (.-y shape) 220))
              (t/is (m/close? (get-in @store (get-shape-path :y)) 220)))

            (t/testing " - parentX"
              (set! (.-parentX ^js shape) 30)
              (t/is (m/close? (.-parentX ^js shape) 30))
              (t/is (m/close? (.-x shape) 130))
              (t/is (m/close? (get-in @store (get-shape-path :x)) 130)))

            (t/testing " - parentY"
              (set! (.-parentY ^js shape) 40)
              (t/is (m/close? (.-parentY ^js shape) 40))
              (t/is (m/close? (.-y shape) 240))
              (t/is (m/close? (get-in @store (get-shape-path :y)) 240)))))

        (t/testing "Clone")
        (t/testing "Remove")

        (t/testing "WASM mocks were exercised"
          (t/is (pos? (thw/call-count :clean-modifiers)))
          (t/is (pos? (thw/call-count :set-structure-modifiers)))
          (t/is (pos? (thw/call-count :propagate-modifiers))))))))

(t/deftest test-array-properties-return-empty-array-when-no-items
  ;; Array-typed properties must always return an array, never null,
  ;; even when the shape has no items for that property.
  (thw/with-wasm-mocks*
    (fn []
      (let [store       (ths/setup-store (cthf/sample-file :file1 :page-label :page1))
            ^js context (api/create-context "00000000-0000-0000-0000-000000000000")
            _           (set! st/state store)
            ^js shape   (.createRectangle context)]

        (t/testing " - exports (no exports set)"
          (let [exports (.-exports shape)]
            (t/is (array? exports))
            (t/is (= 0 (.-length exports)))))

        (t/testing " - shadows (no shadows set)"
          (let [shadows (.-shadows shape)]
            (t/is (array? shadows))
            (t/is (= 0 (.-length shadows)))))))))

;; ---- waitForLayoutUpdate tests ------------------------------------------
;;
;; `waitForLayoutUpdate` resolves once the shapes with reflow work in flight
;; have drained from the `app.main.data.workspace.reflow` pending task map.
;; The tests drive that map directly with `start!` / `finish!` instead
;; of replaying internal pipeline events. A minimal store is still installed so
;; `create-context` / `shape-proxy` can resolve the global st/state.

(def ^:private original-st-state st/state)
(def ^:private original-st-stream st/stream)
(def ^:private zero-id "00000000-0000-0000-0000-000000000000")

(t/use-fixtures :each
  {:before (fn []
             ;; Keep the WASM mocks installed across the async test bodies:
             ;; debounced text-resize timers leaked by earlier test namespaces
             ;; can fire inside this namespace's async waits, and in Node they
             ;; would otherwise reach the real (unavailable) WASM API.
             (thw/setup-wasm-mocks!)
             (wrf/reset-pending!))
   :after (fn []
            (thw/teardown-wasm-mocks!)
            (wrf/reset-pending!)
            (set! st/state original-st-state)
            (set! st/stream original-st-stream))})

(defn- make-test-store
  "Creates a minimal potok store with an empty state map and installs it as the
  global st/state and st/stream for the duration of the calling test."
  []
  (let [test-store (ptk/store {:state {} :on-error (fn [e] (js/console.error e))})]
    (set! st/state test-store)
    (set! st/stream (ptk/input-stream test-store))
    test-store))

(t/deftest test-update-shapes-invokes-update-function-once
  (let [store    (ths/setup-store (cthf/sample-file :file1 :page-label :page1)
                                  {:renderer :svg})
        _        (set! st/state store)
        _        (set! st/stream (ptk/input-stream store))
        ^js ctx  (api/create-context zero-id)
        ^js rect (.createRectangle ctx)
        id       (obj/get rect "$id")
        calls    (atom 0)]
    (ptk/emit! store
               (dwsh/update-shapes
                [id]
                (fn [shape]
                  (swap! calls inc)
                  (assoc shape :opacity 0.5))))
    (t/is (= 1 @calls) "the update function ran once for the committed shape")
    (t/is (= 0.5 (.-opacity rect)) "the single computed result was committed")))

(t/deftest test-wait-for-layout-update-no-pending
  ;; When nothing is pending the promise resolves immediately via the fast path
  ;; (the behavior-subject replays the empty map on subscribe).
  (t/async done
    (make-test-store)
    (let [^js ctx (api/create-context zero-id)]
      (-> (.waitForLayoutUpdate ctx)
          (.then (fn []
                   (t/is true "resolved with no pending work")
                   (done)))
          (.catch (fn [err]
                    (t/is false (str "unexpected rejection: " err))
                    (done)))))))

(t/deftest test-create-text-bridges-dom-measurement
  (t/async done
    (let [store (ths/setup-store (cthf/sample-file :file1 :page-label :page1)
                                 {:renderer :svg})]
      (set! st/state store)
      (set! st/stream (ptk/input-stream store))
      (ptk/emit! store (dwtxt/initialize-text-reflow))
      (let [^js ctx  (api/create-context zero-id)
            ^js text (.createText ctx "Measure me")
            id       (obj/get text "$id")]
        (-> (.waitForLayoutUpdate ctx 20)
            (.then #(t/is false "createText resolved before DOM measurement started"))
            (.catch #(t/is true "createText stayed bridged to DOM measurement"))
            (.then (fn []
                     (let [task (wrf/start! :text-measure [id])]
                       (wrf/finish! task))
                     (.waitForLayoutUpdate ctx 100)))
            (.then #(t/is true "the bridge drained after measurement started"))
            (.catch #(t/is false "the createText bridge did not drain"))
            (.then (fn []
                     (ptk/emit! store (dwtxt/finalize-text-reflow))
                     (done))))))))

(t/deftest test-dom-position-data-stays-pending-until-commit
  (t/async done
    (let [store (ths/setup-store (cthf/sample-file :file1 :page-label :page1)
                                 {:renderer :svg})]
      (set! st/state store)
      (set! st/stream (ptk/input-stream store))
      (ptk/emit! store (dwtxt/initialize-text-reflow))
      (let [^js ctx  (api/create-context zero-id)
            ^js text (.createText ctx "Position me")
            id       (obj/get text "$id")
            task     (wrf/start! :text-measure [id])
            position-data
            [{:x 10 :y 20 :width 30 :height 12}]]
        (wrf/finish! task)
        (-> (.waitForLayoutUpdate text 100)
            (.then
             (fn []
               (ptk/emit! store (dwtxt/update-position-data id position-data))
               (-> (.waitForLayoutUpdate text 20)
                   (.then (constantly false))
                   (.catch (constantly true)))))
            (.then
             (fn [timed-out?]
               (t/is timed-out?
                     "position data stayed pending across its debounce")
               (.waitForLayoutUpdate text 500)))
            (.then
             (fn []
               (let [bounds (.-textBounds text)]
                 (t/is (= 30 (obj/get bounds "width"))
                       "the wait exposed the committed text bounds"))
               (ptk/emit! store (dwtxt/finalize-text-reflow))
               (done)))
            (.catch
             (fn [cause]
               (ptk/emit! store (dwtxt/finalize-text-reflow))
               (t/is false (str "position-data wait did not settle: " cause))
               (done))))))))

(t/deftest test-buffered-text-update-bridges-dom-measurement
  (t/async done
    (let [store (ths/setup-store (cthf/sample-file :file1 :page-label :page1)
                                 {:renderer :svg})]
      (set! st/state store)
      (set! st/stream (ptk/input-stream store))
      (ptk/emit! store (dwtxt/initialize-text-reflow))
      (let [^js ctx  (api/create-context zero-id)
            ^js text (.createText ctx "Before")
            id       (obj/get text "$id")
            task     (wrf/start! :text-measure [id])]
        (wrf/finish! task)
        (-> (.waitForLayoutUpdate text 100)
            (.then
             (fn []
               (ptk/emit! store (dwsh/update-shapes-buffer-start))
               (set! (.-characters text) "After")
               (ptk/emit! store (dwsh/update-shapes-buffer-stop))
               (.waitForLayoutUpdate text 20)))
            (.then #(t/is false "buffered update resolved before DOM measurement"))
            (.catch #(t/is true "buffered update stayed bridged to DOM measurement"))
            (.then
             (fn []
               (let [task (wrf/start! :text-measure [id])]
                 (wrf/finish! task))
               (.waitForLayoutUpdate text 100)))
            (.then #(t/is true "the buffered update bridge drained"))
            (.catch #(t/is false "the buffered update bridge did not drain"))
            (.then
             (fn []
               (ptk/emit! store (dwtxt/finalize-text-reflow))
               (done))))))))

(t/deftest test-wasm-grow-type-wait-observes-its-resize
  (t/async done
    (let [store (ths/setup-store (cthf/sample-file :file1 :page-label :page1))]
      (set! st/state store)
      (set! st/stream (ptk/input-stream store))
      (ptk/emit! store (dwtxt/initialize-text-reflow))
      (let [^js ctx  (api/create-context zero-id)
            ^js text (.createText ctx "Resize after grow type")]
        (-> (.waitForLayoutUpdate text 500)
            (.then
             (fn []
               (set! (.-growType text) "fixed")
               (.waitForLayoutUpdate text 500)))
            (.then
             (fn []
               (t/is (= "fixed" (.-growType text))
                     "the grow-type bridge drained after its WASM resize")
               (ptk/emit! store (dwtxt/finalize-text-reflow))
               (done)))
            (.catch
             (fn [cause]
               (ptk/emit! store (dwtxt/finalize-text-reflow))
               (t/is false (str "grow-type wait did not settle: " cause))
               (done))))))))

(t/deftest test-cloned-text-bridges-dom-measurement
  (t/async done
    (let [store (ths/setup-store (cthf/sample-file :file1 :page-label :page1)
                                 {:renderer :svg})]
      (set! st/state store)
      (set! st/stream (ptk/input-stream store))
      (ptk/emit! store (dwtxt/initialize-text-reflow))
      (let [^js ctx  (api/create-context zero-id)
            ^js text (.createText ctx "Clone me")
            id       (obj/get text "$id")
            task     (wrf/start! :text-measure [id])]
        (wrf/finish! task)
        (-> (.waitForLayoutUpdate text 100)
            (.then
             (fn []
               (let [^js clone (.clone text)
                     clone-id  (obj/get clone "$id")]
                 (-> (.waitForLayoutUpdate clone 20)
                     (.then #(t/is false "clone resolved before DOM measurement"))
                     (.catch #(t/is true "clone stayed bridged to DOM measurement"))
                     (.then
                      (fn []
                        (let [task (wrf/start! :text-measure [clone-id])]
                          (wrf/finish! task))
                        (.waitForLayoutUpdate clone 100)))))))
            (.then #(t/is true "the cloned text bridge drained"))
            (.catch #(t/is false "the cloned text bridge did not drain"))
            (.then
             (fn []
               (ptk/emit! store (dwtxt/finalize-text-reflow))
               (done))))))))

(t/deftest test-fixed-text-resize-bridges-dom-measurement
  (t/async done
    (let [store (ths/setup-store (cthf/sample-file :file1 :page-label :page1)
                                 {:renderer :svg})]
      (set! st/state store)
      (set! st/stream (ptk/input-stream store))
      (ptk/emit! store (dwtxt/initialize-text-reflow))
      (let [^js ctx  (api/create-context zero-id)
            ^js text (.createText ctx "Resize me")
            id       (obj/get text "$id")
            task     (wrf/start! :text-measure [id])]
        (wrf/finish! task)
        (-> (.waitForLayoutUpdate text 100)
            (.then
             (fn []
               ;; Finish the grow-type update before resizing.
               (set! (.-growType text) "fixed")
               (let [task (wrf/start! :text-measure [id])]
                 (wrf/finish! task))
               (.waitForLayoutUpdate text 100)))
            (.then
             (fn []
               (.resize text 240 80)
               ;; Turn only this short wait into a boolean.
               (-> (.waitForLayoutUpdate text 20)
                   (.then (fn [] false))
                   (.catch (fn [_] true)))))
            (.then
             (fn [timed-out?]
               (t/is timed-out?
                     "fixed text resize stayed bridged to DOM measurement")
               (let [task (wrf/start! :text-measure [id])]
                 (wrf/finish! task))
               (.waitForLayoutUpdate text 100)))
            (.then
             (fn []
               (t/is true "the resize bridge drained after measurement")
               ;; Match the DOM renderer's 0.001 geometry tolerance.
               (.resize text 240.0005 80)
               (.waitForLayoutUpdate text 100)))
            (.then
             (fn []
               (t/is true "a sub-tolerance resize opened no DOM bridge")
               (ptk/emit! store (dwtxt/finalize-text-reflow))
               (done)))
            (.catch
             (fn [cause]
               (ptk/emit! store (dwtxt/finalize-text-reflow))
               (t/is false (str "unexpected resize bridge rejection: " cause))
               (done))))))))

(t/deftest test-wait-for-layout-update-pending
  ;; While a shape is pending the context promise stays unresolved; it resolves
  ;; once that shape is marked done.
  (t/async done
    (make-test-store)
    (wrf/start! :layout [(uuid/next)])
    (let [^js ctx (api/create-context zero-id)
          resolved (atom false)]
      (-> (.waitForLayoutUpdate ctx)
          (.then (fn [] (reset! resolved true)))
          (.catch (fn [err]
                    (t/is false (str "unexpected rejection: " err)))))
      (js/setTimeout
       (fn []
         (t/is (false? @resolved) "must not resolve while a shape is pending")
         ;; Draining everything resolves the context wait.
         (wrf/reset-pending!)
         (js/setTimeout
          (fn []
            (t/is (true? @resolved) "resolves once nothing is pending")
            (done))
          20))
       20))))

(t/deftest test-wait-for-layout-update-per-shape
  ;; `shape.waitForLayoutUpdate()` only waits for that shape: draining another
  ;; shape must not resolve it; draining its own id does.
  (t/async done
    (make-test-store)
    (let [id-a (uuid/next)
          id-b (uuid/next)
          task-a (wrf/start! :layout [id-a])
          task-b (wrf/start! :layout [id-b])
          ^js shape-a (shape/shape-proxy zero-id uuid/zero uuid/zero id-a)
          resolved (atom false)]
      (-> (.waitForLayoutUpdate shape-a)
          (.then (fn [] (reset! resolved true)))
          (.catch (fn [err]
                    (t/is false (str "unexpected rejection: " err)))))
      ;; Draining the other shape leaves A pending.
      (wrf/finish! task-b)
      (js/setTimeout
       (fn []
         (t/is (false? @resolved) "shape A wait must stay pending while A is pending")
         (wrf/finish! task-a)
         (js/setTimeout
          (fn []
            (t/is (true? @resolved) "resolves once shape A drains")
            (done))
          20))
       20))))

(t/deftest test-wait-for-layout-update-overlapping-tasks
  ;; Two overlapping operations on the same shape: finishing one task must not
  ;; resolve the wait while the second operation is still in flight.
  (t/async done
    (make-test-store)
    (let [id (uuid/next)
          task-a (wrf/start! :layout [id])
          task-b (wrf/start! :layout [id])
          ^js shape (shape/shape-proxy zero-id uuid/zero uuid/zero id)
          resolved (atom false)]
      (-> (.waitForLayoutUpdate shape)
          (.then (fn [] (reset! resolved true)))
          (.catch (fn [err]
                    (t/is false (str "unexpected rejection: " err)))))
      ;; First operation finishes; second is still pending.
      (wrf/finish! task-a)
      (js/setTimeout
       (fn []
         (t/is (false? @resolved) "must not resolve while a second op is in flight")
         (wrf/finish! task-b)
         (js/setTimeout
          (fn []
            (t/is (true? @resolved) "resolves once both operations drain")
            (done))
          20))
       20))))

(t/deftest test-wait-for-layout-update-timeout
  ;; When the optional timeout fires before the shape drains the promise should
  ;; reject with an Error whose message mentions "timeout".
  (t/async done
    (make-test-store)
    (wrf/start! :layout [(uuid/next)])
    (let [^js ctx (api/create-context zero-id)]
      (-> (.waitForLayoutUpdate ctx 20)
          (.then (fn []
                   (t/is false "expected rejection but promise resolved")
                   (done)))
          (.catch (fn [^js err]
                    (t/is (instance? js/Error err) "rejection value should be an Error")
                    (t/is (some? (re-find #"timeout" (.-message err))) "error message should mention timeout")
                    (done)))))))

(t/deftest test-wait-for-layout-update-subtree
  ;; A shape wait covers its whole subtree: reflow work is often marked on the
  ;; children rather than on the shape the caller holds (a group is re-measured
  ;; through its texts), so a pending child must block the parent.
  (t/async done
    (let [store (ths/setup-store (cthf/sample-file :file1 :page-label :page1))]
      (set! st/state store)
      (set! st/stream (ptk/input-stream store))
      (let [^js ctx   (api/create-context zero-id)
            ^js board (.createBoard ctx)
            ^js rect  (.createRectangle ctx)]
        (.appendChild board rect)
        (let [child-id (obj/get rect "$id")
              task (wrf/start! :layout [child-id])
              resolved (atom false)]
          (-> (.waitForLayoutUpdate board)
              (.then (fn [] (reset! resolved true)))
              (.catch (fn [err]
                        (t/is false (str "unexpected rejection: " err)))))
          (js/setTimeout
           (fn []
             (t/is (false? @resolved) "parent wait must block on a pending child")
             (wrf/finish! task)
             (js/setTimeout
              (fn []
                (t/is (true? @resolved) "resolves once the child drains")
                (done))
              20))
           20))))))

(t/deftest test-wait-for-layout-update-ancestor
  ;; A shape wait also covers layout on its parents.
  (t/async done
    (let [store (ths/setup-store (cthf/sample-file :file1 :page-label :page1))]
      (set! st/state store)
      (set! st/stream (ptk/input-stream store))
      (let [^js ctx   (api/create-context zero-id)
            ^js board (.createBoard ctx)
            ^js rect  (.createRectangle ctx)]
        (.appendChild board rect)
        (let [board-id (obj/get board "$id")
              task     (wrf/start! :layout [board-id])
              resolved (atom false)]
          (-> (.waitForLayoutUpdate rect)
              (.then (fn [] (reset! resolved true)))
              (.catch (fn [err]
                        (t/is false (str "unexpected rejection: " err)))))
          (js/setTimeout
           (fn []
             (t/is (false? @resolved) "child wait must block on a pending ancestor")
             (wrf/finish! task)
             (js/setTimeout
              (fn []
                (t/is (true? @resolved) "resolves once the ancestor drains")
                (done))
              20))
           20))))))

(t/deftest test-shape-wait-observes-file-sync
  (t/async done
    (let [file  (cthf/sample-file :file1 :page-label :page1)
          store (ths/setup-store file)
          _     (set! st/state store)
          _     (set! st/stream (ptk/input-stream store))
          ^js ctx   (api/create-context zero-id)
          ^js shape (.createRectangle ctx)
          task      (wrf/start! :sync-file [(:id file)])]
      (-> (.waitForLayoutUpdate shape 20)
          (.then #(t/is false "shape wait ignored its pending file sync"))
          (.catch
           (fn []
             (t/is true "shape wait remained pending for its file sync")
             (wrf/finish! task)
             (.waitForLayoutUpdate shape 100)))
          (.then #(t/is true "shape wait drained after the file sync"))
          (.catch #(t/is false "shape wait did not drain its file sync"))
          (.then (fn [] (done)))))))

(t/deftest test-wait-for-layout-update-invalid-timeout
  ;; A non-numeric or non-positive timeout is an invalid argument. The method
  ;; always hands back a promise and rejects it, whatever the plugin's
  ;; throwValidationErrors flag says.
  (t/async done
    (make-test-store)
    (let [^js ctx   (api/create-context zero-id)
          ^js shape (shape/shape-proxy zero-id uuid/zero uuid/zero (uuid/next))
          rejected? (fn [^js promise]
                      (t/is (instance? js/Promise promise) "must return a promise")
                      (-> promise
                          (.then (fn [] false))
                          (.catch (fn [] true))))]
      (-> (js/Promise.all
           #js [(rejected? (.waitForLayoutUpdate ctx "soon"))
                (rejected? (.waitForLayoutUpdate ctx 0))
                (rejected? (.waitForLayoutUpdate ctx -5))
                (rejected? (.waitForLayoutUpdate ctx js/NaN))
                (rejected? (.waitForLayoutUpdate ctx js/Infinity))
                (rejected? (.waitForLayoutUpdate ctx 2147483648))
                (rejected? (.waitForLayoutUpdate shape "soon"))])
          (.then (fn [results]
                   (t/is (every? true? (array-seq results))
                         "every invalid timeout must reject")
                   (done)))))))

(t/deftest test-with-pending-marks-on-subscribe
  ;; `with-pending` marks on subscription, not while the observable is being
  ;; built, so an observable that is never subscribed leaves nothing pending.
  (t/async done
    (make-test-store)
    (let [id      (uuid/next)
          ;; Built but never subscribed.
          _       (wrf/with-pending :layout [id] (rx/of :ignored))
          ^js ctx (api/create-context zero-id)]
      (-> (.waitForLayoutUpdate ctx 50)
          (.then (fn []
                   (t/is true "an unsubscribed with-pending must not mark anything")
                   (done)))
          (.catch (fn [err]
                    (t/is false (str "unexpected rejection: " err))
                    (done)))))))

(t/deftest test-with-pending-drains-on-terminate
  ;; Once subscribed, the shape is pending for the lifetime of the wrapped
  ;; observable and drains when it completes.
  (t/async done
    (make-test-store)
    (let [id       (uuid/next)
          subject  (rx/subject)
          ^js shape (shape/shape-proxy zero-id uuid/zero uuid/zero id)
          resolved (atom false)]
      (rx/sub! (wrf/with-pending :layout [id] subject) (fn [_] nil))
      (-> (.waitForLayoutUpdate shape)
          (.then (fn [] (reset! resolved true)))
          (.catch (fn [err]
                    (t/is false (str "unexpected rejection: " err)))))
      (js/setTimeout
       (fn []
         (t/is (false? @resolved) "must stay pending while the wrapped stream is alive")
         (rx/end! subject)
         (js/setTimeout
          (fn []
            (t/is (true? @resolved) "resolves once the wrapped stream completes")
            (done))
          20))
       20))))

(t/deftest test-resize-wasm-text-all-pending-across-buffer-commit
  ;; While a shape-update buffer is open (token propagation) `resize-wasm-text-all`
  ;; holds the resizes back until the commit lands, and the shapes stay pending
  ;; for that whole wait.
  (t/async done
    (let [store    (ths/setup-store (cthf/sample-file :file1 :page-label :page1))
          id       (uuid/next)
          resolved (atom false)]
      (ptk/emit! store (dwsh/update-shapes-buffer-start))
      (ptk/emit! store (dwwt/resize-wasm-text-all [id]))
      (-> (pwrf/wait-for-layout-update [id] nil)
          (.then (fn [] (reset! resolved true)))
          (.catch (fn [err]
                    (t/is false (str "unexpected rejection: " err)))))
      (js/setTimeout
       (fn []
         (t/is (false? @resolved) "must stay pending while the buffer has not committed")
         (ptk/emit! store (dwsh/update-shapes-buffer-commit))
         ;; Covers the commit plus the per-shape debounce the resizes go through.
         (js/setTimeout
          (fn []
            (t/is (true? @resolved) "resolves once the commit releases the resizes")
            (done))
          300))
       50))))
