Merge pull request #3594 from penpot/niwinz-develop-experiments-1

🐛 Several bugfixes and other minor imprivements

.clj-kondo/hooks/export.clj

@@ -41,18 +41,22 @@
 
 (defn penpot-with-atomic
   [{:keys [node]}]
-  (let [[_ params & other] (:children node)
+  (let [[params & body] (rest (:children node))]
+    (if (api/vector-node? params)
+      (let [[sym val opts] (:children params)]
+        (when-not (and sym val)
+          (throw (ex-info "No sym and val provided" {})))
+        {:node (api/list-node
+                (list*
+                 (api/token-node 'let)
+                 (api/vector-node [sym val])
+                 opts
+                 body))})
 
-        result (if (api/vector-node? params)
+      {:node (api/list-node
-                 (api/list-node
+              (into [(api/token-node 'let)
-                  (into [(api/token-node (symbol "clojure.core" "with-open")) params] other))
+                     (api/vector-node [params params])]
-                 (api/list-node
+                    body))})))
-                  (into [(api/token-node (symbol "clojure.core" "with-open"))
-                         (api/vector-node [params params])]
-                        other)))
-
-        ]
-    {:node result}))
 
 (defn penpot-defrecord
   [{:keys [:node]}]

backend/src/app/db.clj

@@ -145,6 +145,10 @@
   [v]
   (instance? javax.sql.DataSource v))
 
+(defn connection?
+  [conn]
+  (instance? Connection conn))
+
 (s/def ::conn some?)
 (s/def ::nilable-pool (s/nilable ::pool))
 (s/def ::pool pool?)
@@ -230,46 +234,59 @@
   [pool]
   (jdbc/get-connection pool))
 
+(defn- resolve-connectable
+  [o]
+  (if (connection? o)
+    o
+    (if (pool? o)
+      o
+      (or (::conn o) (::pool o)))))
+
+
 (def ^:private default-opts
   {:builder-fn sql/as-kebab-maps})
 
 (defn exec!
   ([ds sv]
-   (jdbc/execute! ds sv default-opts))
+   (-> (resolve-connectable ds)
+       (jdbc/execute! sv default-opts)))
   ([ds sv opts]
-   (jdbc/execute! ds sv (merge default-opts opts))))
+   (-> (resolve-connectable ds)
+       (jdbc/execute! sv (merge default-opts opts)))))
 
 (defn exec-one!
   ([ds sv]
-   (jdbc/execute-one! ds sv default-opts))
+   (-> (resolve-connectable ds)
+       (jdbc/execute-one! sv default-opts)))
   ([ds sv opts]
-   (jdbc/execute-one! ds sv
+   (-> (resolve-connectable ds)
-                      (-> (merge default-opts opts)
+       (jdbc/execute-one! sv
-                          (assoc :return-keys (::return-keys? opts false))))))
+                          (-> (merge default-opts opts)
+                              (assoc :return-keys (::return-keys? opts false)))))))
 
 (defn insert!
   [ds table params & {:as opts}]
-  (exec-one! ds
+  (-> (resolve-connectable ds)
-             (sql/insert table params opts)
+      (exec-one! (sql/insert table params opts)
-             (merge {::return-keys? true} opts)))
+                 (merge {::return-keys? true} opts))))
 
 (defn insert-multi!
   [ds table cols rows & {:as opts}]
-  (exec! ds
+  (-> (resolve-connectable ds)
-         (sql/insert-multi table cols rows opts)
+      (exec! (sql/insert-multi table cols rows opts)
-         (merge {::return-keys? true} opts)))
+             (merge {::return-keys? true} opts))))
 
 (defn update!
   [ds table params where & {:as opts}]
-  (exec-one! ds
+  (-> (resolve-connectable ds)
-             (sql/update table params where opts)
+      (exec-one! (sql/update table params where opts)
-             (merge {::return-keys? true} opts)))
+                 (merge {::return-keys? true} opts))))
 
 (defn delete!
   [ds table params & {:as opts}]
-  (exec-one! ds
+  (-> (resolve-connectable ds)
-             (sql/delete table params opts)
+      (exec-one! (sql/delete table params opts)
-             (merge {::return-keys? true} opts)))
+                 (merge {::return-keys? true} opts))))
 
 (defn is-row-deleted?
   [{:keys [deleted-at]}]
@@ -301,7 +318,8 @@
 
 (defn plan
   [ds sql]
-  (jdbc/plan ds sql sql/default-opts))
+  (-> (resolve-connectable ds)
+      (jdbc/plan sql sql/default-opts)))
 
 (defn get-by-id
   [ds table id & {:as opts}]
@@ -371,10 +389,6 @@
   [data]
   (org.postgresql.util.PGInterval. ^String data))
 
-(defn connection?
-  [conn]
-  (instance? Connection conn))
-
 (defn savepoint
   ([^Connection conn]
    (.setSavepoint conn))

common/src/app/common/files/defaults.cljc

@@ -6,4 +6,4 @@
 
 (ns app.common.files.defaults)
 
-(def version 29)
+(def version 30)

common/src/app/common/files/migrations.cljc

@@ -23,7 +23,7 @@
    [app.common.uuid :as uuid]
    [cuerdas.core :as str]))
 
-#?(:cljs (log/set-level! :info))
+#?(:cljs (l/set-level! :info))
 
 (defmulti migrate :version)
 
@@ -561,3 +561,18 @@
     (-> data
         (update :pages-index update-vals update-container)
         (update :components update-vals update-container))))
+
+(defmethod migrate 30
+  [data]
+  (letfn [(update-object [object]
+            (if (and (cph/frame-shape? object)
+                     (not (:shapes object)))
+              (assoc object :shapes [])
+              object))
+
+          (update-container [container]
+            (update container :objects update-vals update-object))]
+
+    (-> data
+        (update :pages-index update-vals update-container)
+        (update :components update-vals update-container))))

common/src/app/common/pages/changes.cljc

@@ -97,6 +97,7 @@
      [:map {:title "FixObjChange"}
       [:type [:= :fix-obj]]
       [:id ::sm/uuid]
+      [:fix {:optional true} :keyword]
       [:page-id {:optional true} ::sm/uuid]
       [:component-id {:optional true} ::sm/uuid]]]
 
@@ -402,10 +403,16 @@
     (d/update-in-when data [:components component-id] ctst/delete-shape id ignore-touched)))
 
 (defmethod process-change :fix-obj
-  [data {:keys [page-id component-id] :as params}]
+  [data {:keys [page-id component-id id] :as params}]
-  (if page-id
+  (letfn [(fix-container [container]
-    (d/update-in-when data [:pages-index page-id] ctst/fix-shape-children params)
+            (case (:fix params :broken-children)
-    (d/update-in-when data [:components component-id] ctst/fix-shape-children params)))
+              :broken-children (ctst/fix-broken-children container id)
+              (ex/raise :type :internal
+                        :code :fix-not-implemented
+                        :fix (:fix params))))]
+    (if page-id
+      (d/update-in-when data [:pages-index page-id] fix-container)
+      (d/update-in-when data [:components component-id] fix-container))))
 
 ;; FIXME: remove, seems like this method is already unused
 ;; reg-objects operation "regenerates" the geometry and selrect of the parent groups

common/src/app/common/types/shape/radius.cljc

@@ -51,19 +51,14 @@
 (defn switch-to-radius-1
   [shape]
   (let [r (if (all-equal? shape) (:r1 shape) 0)]
-    (cond-> shape
+    (-> shape
-      (:r1 shape)
+        (assoc :rx r :ry r)
-      (-> (assoc :rx r :ry r)
+        (dissoc :r1 :r2 :r3 :r4))))
-          (dissoc :r1 :r2 :r3 :r4)))))
 
 (defn switch-to-radius-4
   [shape]
-  (cond-> shape
+  (let [rx (:rx shape 0)]
-    (:rx shape)
+    (-> (assoc shape :r1 rx :r2 rx :r3 rx :r4 rx)
-    (-> (assoc :r1 (:rx shape)
-               :r2 (:rx shape)
-               :r3 (:rx shape)
-               :r4 (:rx shape))
         (dissoc :rx :ry))))
 
 (defn set-radius-1

common/src/app/common/types/shape_tree.cljc

@@ -99,10 +99,10 @@
 
      (update container :objects delete-from-objects))))
 
-(defn fix-shape-children
+(defn fix-broken-children
   "Checks and fix the children relations of the shape. If a children does not
   exists on the objects tree, it will be removed from shape."
-  [{:keys [objects] :as container} {:keys [id] :as params}]
+  [{:keys [objects] :as container} id]
   (let [contains? (partial contains? objects)]
     (d/update-in-when container [:objects id :shapes]
                       (fn [shapes]

frontend/src/app/main/data/workspace.cljs

@@ -46,7 +46,7 @@
    [app.main.data.workspace.drawing.common :as dwdc]
    [app.main.data.workspace.edition :as dwe]
    [app.main.data.workspace.fix-bool-contents :as fbc]
-   [app.main.data.workspace.fix-broken-shape-links :as fbs]
+   [app.main.data.workspace.fix-broken-shapes :as fbs]
    [app.main.data.workspace.fix-deleted-fonts :as fdf]
    [app.main.data.workspace.groups :as dwg]
    [app.main.data.workspace.guides :as dwgu]

frontend/src/app/main/data/workspace/fix_broken_shapes.cljs

@@ -4,15 +4,15 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.main.data.workspace.fix-broken-shape-links
+(ns app.main.data.workspace.fix-broken-shapes
   (:require
    [app.main.data.workspace.changes :as dch]
    [beicon.core :as rx]
    [potok.core :as ptk]))
 
-(defn- generate-changes
+(defn- generate-broken-link-changes
   [attr {:keys [objects id] :as container}]
-  (let [base      {:type :fix-obj attr id}
+  (let [base      {:type :fix-obj :fix :broken-children attr id}
         contains? (partial contains? objects)
         xform     (comp
                    ;; FIXME: Ensure all obj have id field (this is needed
@@ -36,14 +36,14 @@
 
 (defn fix-broken-shapes
   []
-  (ptk/reify ::fix-broken-shape-links
+  (ptk/reify ::fix-broken-shapes
     ptk/WatchEvent
     (watch [it state _]
       (let [data    (get state :workspace-data)
             changes (concat
-                     (mapcat (partial generate-changes :page-id)
+                     (mapcat (partial generate-broken-link-changes :page-id)
                              (vals (:pages-index data)))
-                     (mapcat (partial generate-changes :component-id)
+                     (mapcat (partial generate-broken-link-changes :component-id)
                              (vals (:components data))))]
 
         (if (seq changes)

frontend/src/app/main/ui/workspace/sidebar/options/menus/measures.cljs

@@ -169,7 +169,7 @@
 
         on-proportion-lock-change
         (mf/use-callback
-         (mf/deps ids)
+         (mf/deps ids proportion-lock)
          (fn [_]
            (let [new-lock (if (= proportion-lock :multiple) true (not proportion-lock))]
              (run! #(st/emit! (udw/set-shape-proportion-lock % new-lock)) ids))))
@@ -207,7 +207,7 @@
 
         on-switch-to-radius-1
         (mf/use-callback
-         (mf/deps ids)
+         (mf/deps ids change-radius)
          (fn [_value]
            (if all-equal?
              (st/emit! (change-radius ctsr/switch-to-radius-1))
@@ -215,20 +215,20 @@
 
         on-switch-to-radius-4
         (mf/use-callback
-         (mf/deps ids)
+         (mf/deps ids change-radius)
          (fn [_value]
            (st/emit! (change-radius ctsr/switch-to-radius-4))
            (reset! radius-multi? false)))
 
         on-radius-1-change
         (mf/use-callback
-         (mf/deps ids)
+         (mf/deps ids change-radius)
          (fn [value]
            (st/emit! (change-radius #(ctsr/set-radius-1 % value)))))
 
         on-radius-multi-change
         (mf/use-callback
-         (mf/deps ids)
+         (mf/deps ids change-radius)
          (fn [event]
            (let [value (-> event dom/get-target dom/get-value d/parse-integer)]
              (when (some? value)
@@ -238,7 +238,7 @@
 
         on-radius-4-change
         (mf/use-callback
-         (mf/deps ids)
+         (mf/deps ids change-radius)
          (fn [value attr]
            (st/emit! (change-radius #(ctsr/set-radius-4 % attr value)))))