✨ Enhance dump-tree debug command and add dump-subtree

common/src/app/common/types/components_list.cljc

@@ -13,9 +13,12 @@
    [app.common.types.component :as ctk]))
 
 (defn components
-  [file-data]
+  ([file-data] (components file-data nil))
+  ([file-data {:keys [include-deleted?] :or {include-deleted? false}}]
+   (if include-deleted?
+     (:components file-data)
      (d/removem (fn [[_ component]] (:deleted component))
-             (:components file-data)))
+                (:components file-data)))))
 
 (defn components-seq
   [file-data]

common/src/app/common/types/container.cljc

@@ -104,14 +104,30 @@
      (cph/root? shape)
      nil
 
+     (ctk/instance-root? shape)
+     shape
+
      (and (not (ctk/in-component-copy? shape)) (not allow-main?))
      nil
 
+     :else
+     (get-component-shape objects (get objects (:parent-id shape)) options))))
+
+(defn get-instance-root
+  "Get the parent shape at the top of the component instance (main or copy)."
+  [objects shape]
+  (cond
+    (nil? shape)
+    nil
+    
+    (cph/root? shape)
+    nil
+    
     (ctk/instance-root? shape)
     shape
     
     :else
-     (get-component-shape objects (get objects (:parent-id shape)) options))))
+    (get-instance-root objects (get objects (:parent-id shape)))))
 
 (defn get-copy-root
   "Get the top shape of the copy."

common/src/app/common/types/file.cljc

@@ -114,13 +114,13 @@
 
 (defn find-component
   "Retrieve a component from libraries, iterating over all of them."
-  [libraries component-id & {:keys [included-delete?] :or {included-delete? false}}]
+  [libraries component-id & {:keys [include-deleted?] :or {include-deleted? false}}]
-  (some #(ctkl/get-component (:data %) component-id included-delete?) (vals libraries)))
+  (some #(ctkl/get-component (:data %) component-id include-deleted?) (vals libraries)))
 
 (defn get-component
   "Retrieve a component from a library."
-  [libraries library-id component-id & {:keys [included-delete?] :or {included-delete? false}}]
+  [libraries library-id component-id & {:keys [include-deleted?] :or {include-deleted? false}}]
-  (ctkl/get-component (dm/get-in libraries [library-id :data]) component-id included-delete?))
+  (ctkl/get-component (dm/get-in libraries [library-id :data]) component-id include-deleted?))
 
 (defn get-component-library
   "Retrieve the library the component belongs to."
@@ -573,33 +573,21 @@
 
 ;; Debug helpers
 
-(defn dump-tree
+(declare dump-shape-component-info)
-  ([file-data page-id libraries]
-   (dump-tree file-data page-id libraries false false false))
 
-  ([file-data page-id libraries show-ids]
+(defn dump-shape
-   (dump-tree file-data page-id libraries show-ids false false))
+  "Display a summary of a shape and its relationships, and recursively of all children."
-
+  [shape-id level objects file libraries {:keys [show-ids show-touched] :as flags}]
-  ([file-data page-id libraries show-ids show-touched]
-   (dump-tree file-data page-id libraries show-ids show-touched false))
-
-  ([file-data page-id libraries show-ids show-touched show-modified]
-   (let [page       (ctpl/get-page file-data page-id)
-         objects    (:objects page)
-         components (ctkl/components file-data)
-         root       (get objects uuid/zero)]
-
-     (letfn [(show-shape [shape-id level objects]
   (let [shape (get objects shape-id)]
     (println (str/pad (str (str/repeat "  " level)
                            (when (:main-instance shape) "{")
                            (:name shape)
                            (when (:main-instance shape) "}")
                            (when (seq (:touched shape)) "*")
-                                        (when show-ids (str/format " <%s>" (:id shape))))
+                           (when show-ids (str/format " %s" (:id shape))))
                       {:length 20
                        :type :right})
-                          (show-component-info shape objects))
+             (dump-shape-component-info shape objects file libraries flags))
     (when show-touched
       (when (seq (:touched shape))
         (println (str (str/repeat "  " level)
@@ -610,35 +598,47 @@
                       "    (remote-synced)"))))
     (when (:shapes shape)
       (dorun (for [shape-id (:shapes shape)]
-                            (show-shape shape-id (inc level) objects))))))
+               (dump-shape shape-id
+                           (inc level)
+                           objects
+                           file
+                           libraries
+                           flags))))))
 
-             (show-component-info [shape objects]
+(defn dump-shape-component-info
+  "If the shape is inside a component, display the information of the relationship."
+  [shape objects file libraries {:keys [show-ids]}]
   (if (nil? (:shape-ref shape))
-                 (if (:component-root shape) " #" "")
+    (if (:component-root shape)
+      (str " #" (when show-ids (str/format " [Component %s]" (:component-id shape))))
+      "")
     (let [root-shape        (ctn/get-component-shape objects shape)
           component-id      (when root-shape (:component-id root-shape))
           component-file-id (when root-shape (:component-file root-shape))
           component-file    (when component-file-id (get libraries component-file-id nil))
           component         (when component-id
                               (if component-file
-                                             (ctkl/get-component (:data component-file) component-id)
+                                (ctkl/get-component (:data component-file) component-id true)
-                                             (get components component-id)))
+                                (ctkl/get-component (:data file) component-id true)))
           component-shape   (when component
                               (if component-file
                                 (get-ref-shape (:data component-file) component shape)
-                                             (get-ref-shape file-data component shape)))]
+                                (get-ref-shape (:data file) component shape)))]
 
-                   (str/format " %s--> %s%s%s%s"
+      (str/format " %s--> %s%s%s%s%s"
                   (cond (:component-root shape) "#"
                         (:component-id shape) "@"
                         :else "-")
 
                   (when component-file (str/format "<%s> " (:name component-file)))
 
-                               (or (:name component-shape) "?")
+                  (or (:name component-shape)
+                      (str/format "?%s"
+                                  (when show-ids
+                                    (str " " (:shape-ref shape)))))
 
                   (when (and show-ids component-shape)
-                                 (str/format " <%s>" (:id component-shape)))
+                    (str/format " %s" (:id component-shape)))
 
                   (if (or (:component-root shape)
                           (nil? (:component-id shape))
@@ -648,32 +648,180 @@
                           component-file-id (:component-file shape)
                           component-file    (when component-file-id (get libraries component-file-id nil))
                           component         (if component-file
-                                                           (ctkl/get-component (:data component-file) component-id)
+                                              (ctkl/get-component (:data component-file) component-id true)
-                                                           (get components component-id))]
+                                              (ctkl/get-component (:data file) component-id true))]
                       (str/format " (%s%s)"
                                   (when component-file (str/format "<%s> " (:name component-file)))
-                                               (:name component))))))))
+                                  (:name component))))
 
-             (show-component-instance [component]
+                  (when (and show-ids (:component-id shape))
-               (let [page (get-component-page file-data component)
+                    (str/format " [Component %s]" (:component-id shape)))))))
-                     root (get-component-root file-data component)]
-                 (if-not show-ids
-                   (println (str "  [" (:name page) "] / " (:name root)))
-                   (do
-                     (println (str "  " (:name page) (str/format " <%s>" (:id page))))
-                     (println (str "  " (:name root) (str/format " <%s>" (:id root))))))))]
 
-       (println (str "[Page: " (:name page) "]"))
+(defn dump-component
-       (show-shape (:id root) 0 objects)
+  "Display a summary of a component and the links to the main instance.
-
+   If the component contains an :objects, display also all shapes inside."
-       (dorun (for [component (vals components)]
+  [component file libraries {:keys [show-ids show-modified] :as flags}]
-                (do
+  (println (str/format "[%sComponent: %s]%s%s"
-                  (println)
+                       (when (:deleted component) "DELETED ")
-                  (println (str/format "[%s]%s%s"
                        (:name component)
                        (when show-ids (str " " (:id component)))
                        (when show-modified (str " " (:modified-at component)))))
-                  (when (:objects component)
-                    (show-shape (:id component) 0 (:objects component)))
   (when (:main-instance-page component)
-                    (show-component-instance component)))))))))
+    (let [page (get-component-page (:data file) component)
+          root (get-component-root (:data file) component)]
+      (if-not show-ids
+        (println (str "  --> [" (:name page) "] " (:name root)))
+        (do
+          (println (str "  " (:name page) (str/format " %s" (:id page))))
+          (println (str "  " (:name root) (str/format " %s" (:id root))))))))
+
+  (when (and (:main-instance-page component)
+             (seq (:objects component)))
+    (println))
+
+  (when (seq (:objects component))
+    (let [root (ctk/get-component-root component)]
+      (dump-shape (:id root)
+                  1
+                  (:objects component)
+                  file
+                  libraries
+                  flags))))
+
+(defn dump-page
+  "Display a summary of a page, and of all shapes inside."
+  [page file libraries {:keys [show-ids root-id] :as flags
+                        :or {root-id uuid/zero}}]
+  (let [objects (:objects page)
+        root    (get objects root-id)]
+    (println (str/format "[Page: %s]%s"
+                         (:name page)
+                         (when show-ids (str " " (:id page)))))
+    (dump-shape (:id root)
+                1
+                objects
+                file
+                libraries
+                flags)))
+
+(defn dump-library
+  "Display a summary of a library, and of all components inside."
+  [library file libraries {:keys [show-ids only include-deleted?] :as flags}]
+  (let [lib-components (ctkl/components (:data library) {:include-deleted? include-deleted?})]
+    (println)
+    (println (str/format "========= %s%s"
+                         (if (= (:id library) (:id file))
+                           "Local library"
+                           (str/format "Library %s" (:name library)))
+                         (when show-ids
+                           (str/format " %s" (:id library)))))
+
+    (if (seq lib-components)
+      (dorun (for [component (vals lib-components)]
+               (when (or (nil? only) (only (:id component)))
+                 (do
+                   (println)
+                   (dump-component component
+                                   library
+                                   libraries
+                                   flags)))))
+      (do
+        (println)
+        (println "(no components)")))))
+
+(defn dump-tree
+  "Display all shapes in the given page, and also all components of the local
+   library and all linked libraries."
+  [file page-id libraries flags]
+  (let [page (ctpl/get-page (:data file) page-id)]
+
+    (dump-page page file libraries flags)
+
+    (dump-library file
+                  file
+                  libraries
+                  flags)
+
+    (dorun (for [library (vals libraries)]
+             (dump-library library
+                           file
+                           libraries
+                           flags)))
+    (println)))
+
+(defn dump-subtree
+  "Display all shapes in the context of the given shape, and also the components
+   used by any of the shape or children."
+  [file page-id shape-id libraries flags]
+  (let [libraries* (assoc libraries (:id file) file)]
+    (letfn [(add-component
+              [libs-to-show library-id component-id]
+              ;; libs-to-show is a structure like {<lib1-id> #{<comp1-id> <comp2-id>}
+              ;;                                   <lib2-id> #{<comp3-id>}
+              (let [component-ids (conj (get libs-to-show library-id #{})
+                                        component-id)]
+                (assoc libs-to-show library-id component-ids)))
+
+            (find-used-components
+              [page root]
+              (let [children (cph/get-children-with-self (:objects page) (:id root))]
+                (reduce (fn [libs-to-show shape]
+                          (if (ctk/instance-head? shape)
+                            (add-component libs-to-show (:component-file shape) (:component-id shape))
+                            libs-to-show))
+                        {}
+                        children)))
+
+            (find-used-components-cumulative
+              [libs-to-show page root]
+              (let [sublibs-to-show (find-used-components page root)]
+                (reduce (fn [libs-to-show [library-id components]]
+                          (reduce (fn [libs-to-show component-id]
+                                    (let [library   (get libraries* library-id)
+                                          component (get-component libraries* library-id component-id {:include-deleted? true})
+                                          ;; page      (get-component-page (:data library) component)
+                                          root      (when component
+                                                      (get-component-root (:data library) component))]
+                                      (if (nil? component)
+                                        (do
+                                          (println (str/format "(Cannot find component %s in library %s)"
+                                                               component-id library-id))
+                                          libs-to-show)
+                                        (if (get-in libs-to-show [library-id (:id root)])
+                                          libs-to-show
+                                          (-> libs-to-show
+                                              (add-component library-id component-id)
+                                              ;; (find-used-components-cumulative page root)
+                                              )))))
+                                  libs-to-show
+                                  components))
+                        libs-to-show
+                        sublibs-to-show)))]
+
+      (let [page (ctpl/get-page (:data file) page-id)
+            shape (ctst/get-shape page shape-id)
+            root (or (ctn/get-instance-root (:objects page) shape)
+                     shape) ; If not in a component, start by the shape itself
+
+            libs-to-show (find-used-components-cumulative {} page root)]
+
+        (if (nil? root)
+          (println (str "Cannot find shape " shape-id))
+          (do
+            (dump-page page file libraries (assoc flags :root-id (:id root)))
+            (dorun (for [[library-id component-ids] libs-to-show]
+                     (let [library (get libraries* library-id)]
+                       (dump-library library
+                                     file
+                                     libraries
+                                     (assoc flags
+                                            :only component-ids
+                                            :include-deleted? true))
+                       (dorun (for [component-id component-ids]
+                                (let [library   (get libraries* library-id)
+                                      component (get-component libraries* library-id component-id {:include-deleted? true})
+                                      page      (get-component-page (:data library) component)
+                                      root      (get-component-root (:data library) component)]
+                                  (when-not (:deleted component)
+                                    (println)
+                                    (dump-page page file libraries* (assoc flags :root-id (:id root))))))))))))))))

frontend/src/debug.cljs

@@ -303,16 +303,36 @@
   ([state show-ids show-touched] (dump-tree' state show-ids show-touched false))
   ([state show-ids show-touched show-modified]
    (let [page-id    (get state :current-page-id)
-         file-data  (get state :workspace-data)
+         file       (assoc (get state :workspace-file)
+                           :data (get state :workspace-data))
          libraries  (get state :workspace-libraries)]
-     (ctf/dump-tree file-data page-id libraries show-ids show-touched show-modified))))
+     (ctf/dump-tree file page-id libraries {:show-ids show-ids
-
+                                            :show-touched show-touched
+                                            :show-modified show-modified}))))
 (defn ^:export dump-tree
   ([] (dump-tree' @st/state))
   ([show-ids] (dump-tree' @st/state show-ids false false))
   ([show-ids show-touched] (dump-tree' @st/state show-ids show-touched false))
   ([show-ids show-touched show-modified] (dump-tree' @st/state show-ids show-touched show-modified)))
 
+(defn ^:export dump-subtree'
+  ([state shape-id] (dump-subtree' state shape-id false false false))
+  ([state shape-id show-ids] (dump-subtree' state shape-id show-ids false false))
+  ([state shape-id show-ids show-touched] (dump-subtree' state shape-id show-ids show-touched false))
+  ([state shape-id show-ids show-touched show-modified]
+   (let [page-id    (get state :current-page-id)
+         file       (assoc (get state :workspace-file)
+                           :data (get state :workspace-data))
+         libraries  (get state :workspace-libraries)]
+     (ctf/dump-subtree file page-id shape-id libraries {:show-ids show-ids
+                                                        :show-touched show-touched
+                                                        :show-modified show-modified}))))
+(defn ^:export dump-subtree
+  ([shape-id] (dump-subtree' @st/state (uuid/uuid shape-id)))
+  ([shape-id show-ids] (dump-subtree' @st/state (uuid/uuid shape-id) show-ids false false))
+  ([shape-id show-ids show-touched] (dump-subtree' @st/state (uuid/uuid shape-id) show-ids show-touched false))
+  ([shape-id show-ids show-touched show-modified] (dump-subtree' @st/state (uuid/uuid shape-id) show-ids show-touched show-modified)))
+
 (when *assert*
   (defonce debug-subscription
     (->> st/stream