Merge pull request #4558 from penpot/hiru-enhance-tests-debug

🔧 Enhance debug trace helpers for common tests

common/test/common_tests/helpers/files.cljc

@@ -11,6 +11,7 @@
    [app.common.files.changes :as cfc]
    [app.common.files.validate :as cfv]
    [app.common.pprint :refer [pprint]]
+   [app.common.types.component :as ctk]
    [app.common.types.file :as ctf]
    [app.common.types.page :as ctp]
    [app.common.types.pages-list :as ctpl]
@@ -87,7 +88,7 @@
 
 ;; ----- Debug
 
-(defn dump-file-type
+(defn dump-tree
   "Dump a file using dump-tree function in common.types.file."
   [file & {:keys [page-label libraries] :as params}]
   (let [params    (-> params
@@ -115,44 +116,74 @@
   (println "}"))
 
 (defn- stringify-keys [m keys]
-  (apply str (interpose ", " (map #(str % ": " (get m %)) keys))))
+  (let [kv (-> (select-keys m keys)
+               (assoc :swap-slot (when ((set keys) :swap-slot)
+                                   (ctk/get-swap-slot m)))
+               (assoc :swap-slot-label (when ((set keys) :swap-slot-label)
+                                         (when-let [slot (ctk/get-swap-slot m)]
+                                           (thi/label slot))))
+               (d/without-nils))
+
+        pretty-uuid (fn [id]
+                      (let [id (str id)]
+                        (str "#" (subs id (- (count id) 6)))))
+
+        format-kv (fn [[k v]]
+                    (cond
+                      (uuid? v)
+                      (str k " " (pretty-uuid v))
+
+                      :else
+                      (str k " " v)))]
+
+    (when (seq kv)
+      (str " [" (apply str (interpose ", " (map format-kv kv))) "]"))))
 
 (defn- dump-page-shape
-  [shape keys padding]
+  [shape keys padding show-refs?]
   (println (str/pad (str padding
-                         (when (:main-instance shape) "{")
-                         (or (thi/label (:id shape)) "<no-label>")
-                         (when (:main-instance shape) "}")
-                         (when keys
-                           (str " [" (stringify-keys shape keys) "]")))
-                    {:length 40 :type :right})
+                         (when (and (:main-instance shape) show-refs?) "{")
+                         (thi/label (:id shape))
+                         (when (and (:main-instance shape) show-refs?) "}")
+                         (when (seq keys)
+                           (stringify-keys shape keys)))
+                    {:length 50 :type :right})
            (if (nil? (:shape-ref shape))
-             (if (:component-root shape)
-               (str "# [Component " (or (thi/label (:component-id shape)) "<no-label>") "]")
+             (if (and (:component-root shape) show-refs?)
+               (str "# [Component " (thi/label (:component-id shape)) "]")
                "")
-             (str/format "%s--> %s%s"
-                         (cond (:component-root shape) "#"
-                               (:component-id shape) "@"
-                               :else "-")
-                         (if (:component-root shape)
-                           (str "[Component " (or (thi/label (:component-id shape)) "<no-label>") "] ")
-                           "")
-                         (or (thi/label (:shape-ref shape)) "<no-label>")))))
+             (if show-refs?
+               (str/format "%s--> %s%s"
+                           (cond (:component-root shape) "#"
+                                 (:component-id shape) "@"
+                                 :else "-")
+                           (if (:component-root shape)
+                             (str "[Component " (thi/label (:component-id shape)) "] ")
+                             "")
+                           (thi/label (:shape-ref shape)))
+               ""))))
 
 (defn dump-page
-  "Dump the layer tree of the page. Print the label of each shape, and the specified keys."
-  ([page keys]
-   (dump-page page uuid/zero "" keys))
-  ([page root-id padding keys]
-   (let [lookupf (d/getf (:objects page))
-         root-shape (lookupf root-id)
-         shapes (map lookupf (:shapes root-shape))]
-     (doseq [shape shapes]
-       (dump-page-shape shape keys padding)
-       (dump-page page (:id shape) (str padding "    ") keys)))))
+  "Dump the layer tree of the page, showing labels of the shapes.
+    - keys: a list of attributes of the shapes you want to show. In addition, you
+            can add :swap-slot to show the slot id (if any) or :swap-slot-label
+            to show the corresponding label.
+    - show-refs?: if true, the component references will be shown."
+  [page & {:keys [keys root-id padding show-refs?]
+           :or {keys [:name :swap-slot-label] root-id uuid/zero padding "" show-refs? true}}]
+  (let [lookupf (d/getf (:objects page))
+        root-shape (lookupf root-id)
+        shapes (map lookupf (:shapes root-shape))]
+    (doseq [shape shapes]
+      (dump-page-shape shape keys padding show-refs?)
+      (dump-page page
+                 :keys keys
+                 :root-id (:id shape)
+                 :padding (str padding "    ")
+                 :show-refs? show-refs?))))
 
 (defn dump-file
   "Dump the current page of the file, using dump-page above.
-   Example: (thf/dump-file file [:id :touched])"
-  ([file] (dump-file file []))
-  ([file keys] (dump-page (current-page file) keys)))
+   Example: (thf/dump-file file :keys [:name :swap-slot-label] :show-refs? false)"
+  [file & {:keys [] :as params}]
+  (dump-page (current-page file) params))

common/test/common_tests/helpers/ids_map.cljc

@@ -36,7 +36,8 @@
   (f))
 
 (defn label [id]
-  (->> @idmap
-       (filter #(= id (val %)))
-       (map key)
-       (first)))
+  (or (->> @idmap
+           (filter #(= id (val %)))
+           (map key)
+           (first))
+      (str "<no-label #" (subs id (- (count id) 6)) ">")))

common/test/common_tests/logic/comp_remove_swap_slots_test.cljc

@@ -23,17 +23,16 @@
 ;; Related .penpot file: common/test/cases/remove-swap-slots.penpot
 (defn- setup-file
   []
-    ;;  :frame-b1 [:id: 3aee2370-44e4-81c8-8004-46e56a459d70, :touched: ]
-    ;;      :blue1 [:id: 3aee2370-44e4-81c8-8004-46e56a45fc55, :touched: #{:swap-slot-3aee2370-44e4-81c8-8004-46e56a459d75}]
-    ;;      :green-copy [:id: 3aee2370-44e4-81c8-8004-46e56a45fc56, :touched: ]
-    ;;          :blue-copy-in-green-copy [:id: 3aee2370-44e4-81c8-8004-46e56a4631a4, :touched: #{:swap-slot-3aee2370-44e4-81c8-8004-46e56a459d6f}]
-    ;;      :frame-yellow [:id: 3aee2370-44e4-81c8-8004-46e56a459d73, :touched: ]
-    ;;  :frame-green [:id: 3aee2370-44e4-81c8-8004-46e56a459d6c, :touched: ]
-    ;;      :red-copy-green [:id: 3aee2370-44e4-81c8-8004-46e56a459d6f, :touched: ]
-    ;;  :frame-blue [:id: 3aee2370-44e4-81c8-8004-46e56a459d69, :touched: ]
-    ;;  :frame-b2 [:id: 3aee2370-44e4-81c8-8004-46e56a4631a5, :touched: ]
-    ;;  :frame-red [:id: 3aee2370-44e4-81c8-8004-46e56a459d66, :touched: ]
-
+  ;; {:frame-red} [:name Frame1]                           # [Component :red]
+  ;; {:frame-blue} [:name Frame1]                          # [Component :blue]
+  ;; {:frame-green} [:name Frame1]                         # [Component :green]
+  ;;     :red-copy-green [:name Frame1]                    @--> :frame-red
+  ;; {:frame-b1} [:name Frame1]                            # [Component :b1]
+  ;;     :blue1 [:name Frame1, :swap-slot-label :red-copy] @--> :frame-blue
+  ;;     :frame-yellow [:name Frame1]                   
+  ;;     :green-copy [:name Frame1]                        @--> :frame-green
+  ;;         :blue-copy-in-green-copy [:name Frame1, :swap-slot-label :red-copy-green] @--> :frame-blue
+  ;; {:frame-b2} [:name Frame1]                            # [Component :b2]
   (-> (thf/sample-file :file1)
       (tho/add-frame :frame-red)
       (thc/make-component :red :frame-red)