diff --git a/common/src/app/common/logic/libraries.cljc b/common/src/app/common/logic/libraries.cljc index 409c20b2b..9962ccaae 100644 --- a/common/src/app/common/logic/libraries.cljc +++ b/common/src/app/common/logic/libraries.cljc @@ -5,6 +5,7 @@ ;; Copyright (c) KALEIDOS INC (ns app.common.logic.libraries + #?(:cljs (:require-macros [app.common.logic.libraries :refer [shape-log container-log]])) (:require [app.common.data :as d] [app.common.data.macros :as dm] @@ -35,6 +36,33 @@ ;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default (log/set-level! :warn) +(def log-shape-ids #{}) +(def log-container-ids #{}) + +(defn enabled-shape? + [id container] + (or (empty? log-shape-ids) + (nil? id) + (let [ids (if container + (into #{} (cfh/get-parent-ids-seq-with-self (:objects container) id)) + #{id})] + (seq (set/intersection log-shape-ids ids))))) + +(defmacro shape-log + [level id container & params] + `(when (enabled-shape? ~id ~container) + (log/log ~level ~@params))) + +(defn enabled-container? + [id] + (or (empty? log-container-ids) + (log-container-ids id))) + +(defmacro container-log + [level id & params] + `(when (enabled-container? ~id) + (log/log ~level ~@params))) + (declare generate-sync-container) (declare generate-sync-shape) (declare generate-sync-text-shape) @@ -258,7 +286,8 @@ with a component." [changes container libraries shape-id] (let [shape (ctn/get-shape container shape-id)] - (log/debug :msg "Detach instance" :shape-id shape-id :container (:id container)) + (shape-log :debug shape-id container + :msg "Detach instance" :shape-id shape-id :container (:id container)) (generate-detach-recursive changes container libraries shape-id true (true? (:component-root shape))))) (defn- generate-detach-recursive @@ -375,11 +404,12 @@ (s/assert ::us/uuid file-id) (s/assert ::us/uuid library-id) - (log/info :msg "Sync file with library" - :asset-type asset-type - :asset-id asset-id - :file (pretty-file file-id libraries current-file-id) - :library (pretty-file library-id libraries current-file-id)) + (container-log :info asset-id + :msg "Sync file with library" + :asset-type asset-type + :asset-id asset-id + :file (pretty-file file-id libraries current-file-id) + :library (pretty-file library-id libraries current-file-id)) (let [file (get-in libraries [file-id :data]) components-v2 (get-in file [:options :components-v2])] @@ -413,11 +443,12 @@ (s/assert ::us/uuid file-id) (s/assert ::us/uuid library-id) - (log/info :msg "Sync local components with library" - :asset-type asset-type - :asset-id asset-id - :file (pretty-file file-id libraries current-file-id) - :library (pretty-file library-id libraries current-file-id)) + (container-log :info asset-id + :msg "Sync local components with library" + :asset-type asset-type + :asset-id asset-id + :file (pretty-file file-id libraries current-file-id) + :library (pretty-file library-id libraries current-file-id)) (let [file (get-in libraries [file-id :data]) components-v2 (get-in file [:options :components-v2])] @@ -443,8 +474,8 @@ [changes asset-type asset-id library-id container components-v2 libraries current-file-id] (if (cfh/page? container) - (log/debug :msg "Sync page in local file" :page-id (:id container)) - (log/debug :msg "Sync component in local library" :component-id (:id container))) + (container-log :debug (:id container) :msg "Sync page in local file" :page-id (:id container)) + (container-log :debug (:id container) :msg "Sync component in local library" :component-id (:id container))) (let [linked-shapes (->> (vals (:objects container)) (filter #(uses-assets? asset-type asset-id % library-id)))] @@ -499,7 +530,7 @@ (defmethod generate-sync-shape :colors [_ changes library-id _ shape _ libraries _] - (log/debug :msg "Sync colors of shape" :shape (:name shape)) + (shape-log :debug (:id shape) nil :msg "Sync colors of shape" :shape (:name shape)) ;; Synchronize a shape that uses some colors of the library. The value of the ;; color in the library is copied to the shape. @@ -510,7 +541,7 @@ (defmethod generate-sync-shape :typographies [_ changes library-id container shape _ libraries _] - (log/debug :msg "Sync typographies of shape" :shape (:name shape)) + (shape-log :debug (:id shape) nil :msg "Sync typographies of shape" :shape (:name shape)) ;; Synchronize a shape that uses some typographies of the library. The attributes ;; of the typography are copied to the shape." @@ -672,7 +703,8 @@ "Generate changes to synchronize one shape that is the root of a component instance, and all its children, from the given component." [changes file libraries container shape-id reset? components-v2] - (log/debug :msg "Sync shape direct" :shape-inst (str shape-id) :reset? reset?) + (shape-log :debug shape-id container + :msg "Sync shape direct" :shape-inst (str shape-id) :reset? reset?) (let [shape-inst (ctn/get-shape container shape-id) library (dm/get-in libraries [(:component-file shape-inst) :data]) component (ctkl/get-component library (:component-id shape-inst) true)] @@ -736,7 +768,8 @@ (defn- generate-sync-shape-direct-recursive [changes container shape-inst component library file libraries shape-main root-inst root-main reset? initial-root? redirect-shaperef components-v2] - (log/debug :msg "Sync shape direct recursive" + (shape-log :debug (:id shape-inst) container + :msg "Sync shape direct recursive" :shape-inst (str (:name shape-inst) " " (pretty-uuid (:id shape-inst))) :component (:name component)) @@ -794,7 +827,8 @@ (map #(redirect-shaperef %) children-inst) children-inst) only-inst (fn [changes child-inst] - (log/trace :msg "Only inst" + (shape-log :trace (:id child-inst) container + :msg "Only inst" :child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst)))) (if-not (and omit-touched? (contains? (:touched shape-inst) @@ -806,7 +840,8 @@ changes)) only-main (fn [changes child-main] - (log/trace :msg "Only main" + (shape-log :trace (:id child-main) component-container + :msg "Only main" :child-main (str (:name child-main) " " (pretty-uuid (:id child-main)))) (if-not (and omit-touched? (contains? (:touched shape-inst) @@ -825,7 +860,8 @@ changes)) both (fn [changes child-inst child-main] - (log/trace :msg "Both" + (shape-log :trace (:id child-inst) container + :msg "Both" :child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))) :child-main (str (:name child-main) " " (pretty-uuid (:id child-main)))) (generate-sync-shape-direct-recursive changes @@ -844,14 +880,16 @@ components-v2)) swapped (fn [changes child-inst child-main] - (log/trace :msg "Match slot" + (shape-log :trace (:id child-inst) container + :msg "Match slot" :child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))) :child-main (str (:name child-main) " " (pretty-uuid (:id child-main)))) ;; For now we don't make any sync here. changes) moved (fn [changes child-inst child-main] - (log/trace :msg "Move" + (shape-log :trace (:id child-inst) container + :msg "Move" :child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))) :child-main (str (:name child-main) " " (pretty-uuid (:id child-main)))) (move-shape @@ -863,6 +901,7 @@ omit-touched?))] (compare-children changes + shape-inst children-inst children-main container @@ -901,7 +940,7 @@ "Generate changes to update the component a shape is linked to, from the values in the shape and all its children." [changes file libraries container shape-id components-v2] - (log/debug :msg "Sync shape inverse" :shape (str shape-id)) + (shape-log :debug shape-id container :msg "Sync shape inverse" :shape (str shape-id)) (let [redirect-shaperef (partial redirect-shaperef container libraries) shape-inst (ctn/get-shape container shape-id) library (dm/get-in libraries [(:component-file shape-inst) :data]) @@ -943,7 +982,8 @@ (defn- generate-sync-shape-inverse-recursive [changes container shape-inst component library file libraries shape-main root-inst root-main initial-root? redirect-shaperef components-v2] - (log/trace :msg "Sync shape inverse recursive" + (shape-log :trace (:id shape-inst) container + :msg "Sync shape inverse recursive" :shape (str (:name shape-inst)) :component (:name component)) @@ -1036,7 +1076,8 @@ components-v2)) swapped (fn [changes child-inst child-main] - (log/trace :msg "Match slot" + (shape-log :trace (:id child-inst) container + :msg "Match slot" :child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))) :child-main (str (:name child-main) " " (pretty-uuid (:id child-main)))) ;; For now we don't make any sync here. @@ -1053,6 +1094,7 @@ changes (compare-children changes + shape-inst children-inst children-main container @@ -1084,14 +1126,15 @@ ;; ---- Operation generation helpers ---- (defn- compare-children - [changes children-inst children-main container-inst container-main file libraries only-inst-cb only-main-cb both-cb swapped-cb moved-cb inverse? reset? components-v2] - (log/trace :msg "Compare children") + [changes shape-inst children-inst children-main container-inst container-main file libraries only-inst-cb only-main-cb both-cb swapped-cb moved-cb inverse? reset? components-v2] + (shape-log :trace (:id shape-inst) container-inst :msg "Compare children") (loop [children-inst (seq (or children-inst [])) children-main (seq (or children-main [])) changes changes] (let [child-inst (first children-inst) child-main (first children-main)] - (log/trace :main (str (:name child-main) " " (pretty-uuid (:id child-main))) + (shape-log :trace (:id shape-inst) container-inst + :main (str (:name child-main) " " (pretty-uuid (:id child-main))) :inst (str (:name child-inst) " " (pretty-uuid (:id child-inst)))) (cond (and (nil? child-inst) (nil? child-main)) @@ -1154,10 +1197,11 @@ (defn- add-shape-to-instance [changes component-shape index component-page container root-instance root-main omit-touched? set-remote-synced? components-v2] - (log/info :msg (str "ADD [P " (pretty-uuid (:id container)) "] " - (:name component-shape) - " " - (pretty-uuid (:id component-shape)))) + (shape-log :info (:id component-shape) component-page + :msg (str "ADD [P " (pretty-uuid (:id container)) "] " + (:name component-shape) + " " + (pretty-uuid (:id component-shape)))) (let [component-parent-shape (ctn/get-shape component-page (:parent-id component-shape)) parent-shape (d/seek #(ctk/is-main-of? component-parent-shape % components-v2) (cfh/get-children-with-self (:objects container) @@ -1229,10 +1273,11 @@ (defn- add-shape-to-main [changes shape index component component-container page root-instance root-main components-v2] - (log/info :msg (str "ADD [C " (pretty-uuid (:id component-container)) "] " - (:name shape) - " " - (pretty-uuid (:id shape)))) + (shape-log :info (:id shape) page + :msg (str "ADD [C " (pretty-uuid (:id component-container)) "] " + (:name shape) + " " + (pretty-uuid (:id shape)))) (let [parent-shape (ctn/get-shape page (:parent-id shape)) component-parent-shape (d/seek #(ctk/is-main-of? % parent-shape components-v2) (cfh/get-children-with-self (:objects component-container) @@ -1332,12 +1377,13 @@ (defn- remove-shape [changes shape container omit-touched?] - (log/info :msg (str "REMOVE-SHAPE " - (if (cfh/page? container) "[P " "[C ") - (pretty-uuid (:id container)) "] " - (:name shape) - " " - (pretty-uuid (:id shape)))) + (shape-log :info (:id shape) container + :msg (str "REMOVE-SHAPE " + (if (cfh/page? container) "[P " "[C ") + (pretty-uuid (:id container)) "] " + (:name shape) + " " + (pretty-uuid (:id shape)))) (let [objects (get container :objects) parents (cfh/get-parent-ids objects (:id shape)) parent (first parents) @@ -1384,16 +1430,17 @@ (defn- move-shape [changes shape index-before index-after container omit-touched?] - (log/info :msg (str "MOVE " - (if (cfh/page? container) "[P " "[C ") - (pretty-uuid (:id container)) "] " - (:name shape) - " " - (pretty-uuid (:id shape)) - " " - index-before - " -> " - index-after)) + (shape-log :info (:id shape) container + :msg (str "MOVE " + (if (cfh/page? container) "[P " "[C ") + (pretty-uuid (:id container)) "] " + (:name shape) + " " + (pretty-uuid (:id shape)) + " " + index-before + " -> " + index-after)) (let [parent (ctn/get-shape container (:parent-id shape)) changes' (-> changes @@ -1424,13 +1471,14 @@ (if (nil? (:shape-ref dest-shape)) changes (do - (log/info :msg (str "CHANGE-TOUCHED " - (if (cfh/page? container) "[P " "[C ") - (pretty-uuid (:id container)) "] " - (:name dest-shape) - " " - (pretty-uuid (:id dest-shape))) - :options options) + (shape-log :info (:id dest-shape) container + :msg (str "CHANGE-TOUCHED " + (if (cfh/page? container) "[P " "[C ") + (pretty-uuid (:id container)) "] " + (:name dest-shape) + " " + (pretty-uuid (:id dest-shape))) + :options options) (let [new-touched (cond reset-touched? nil @@ -1466,13 +1514,14 @@ (if (nil? (:shape-ref shape)) changes (do - (log/info :msg (str "CHANGE-REMOTE-SYNCED? " - (if (cfh/page? container) "[P " "[C ") - (pretty-uuid (:id container)) "] " - (:name shape) - " " - (pretty-uuid (:id shape))) - :remote-synced remote-synced?) + (shape-log :info (:id shape) container + :msg (str "CHANGE-REMOTE-SYNCED? " + (if (cfh/page? container) "[P " "[C ") + (pretty-uuid (:id container)) "] " + (:name shape) + " " + (pretty-uuid (:id shape))) + :remote-synced remote-synced?) (-> changes (update :redo-changes conj (make-change container @@ -1535,16 +1584,17 @@ in the destination shape will not be copied." [changes dest-shape origin-shape dest-root origin-root container omit-touched?] - (log/info :msg (str "SYNC " - (:name origin-shape) - " " - (pretty-uuid (:id origin-shape)) - " -> " - (if (cfh/page? container) "[P " "[C ") - (pretty-uuid (:id container)) "] " - (:name dest-shape) - " " - (pretty-uuid (:id dest-shape)))) + (shape-log :info (:id dest-shape) container + :msg (str "SYNC " + (:name origin-shape) + " " + (pretty-uuid (:id origin-shape)) + " -> " + (if (cfh/page? container) "[P " "[C ") + (pretty-uuid (:id container)) "] " + (:name dest-shape) + " " + (pretty-uuid (:id dest-shape)))) (let [;; To synchronize geometry attributes we need to make a prior ;; operation, because coordinates are absolute, but we need to