Merge pull request #5028 from penpot/niwinz-path-changes

🐛 Add missing safechecks and schema validations

backend/src/app/rpc/commands/files_snapshot.clj

@@ -41,8 +41,8 @@
      FROM file_change
     WHERE file_id = ?
       AND created_at < ?
-      AND label is not null
+      AND label IS NOT NULL
-    ORDER BY created_at desc
+    ORDER BY created_at DESC
     LIMIT ?")
 
 (defn get-file-snapshots
@@ -50,7 +50,6 @@
                         :or {limit Long/MAX_VALUE}}]
   (let [start-at (or start-at (dt/now))
         limit    (min limit 20)]
-
     (->> (db/exec! conn [sql:get-file-snapshots file-id start-at limit])
          (mapv (fn [row]
                  (update row :created-at dt/format-instant :rfc1123))))))

common/src/app/common/files/changes.cljc

@@ -176,12 +176,12 @@
     [:add-color
      [:map {:title "AddColorChange"}
       [:type [:= :add-color]]
-      [:color :any]]]
+      [:color ::ctc/color]]]
 
     [:mod-color
      [:map {:title "ModColorChange"}
       [:type [:= :mod-color]]
-      [:color :any]]]
+      [:color ::ctc/color]]]
 
     [:del-color
      [:map {:title "DelColorChange"}
@@ -608,8 +608,7 @@
   (when (and (= object-type :shape) (nil? page-id))
     (ex/raise :type :internal :hint "update for shapes needs a page-id"))
 
-  (letfn [(update-fn
+  (letfn [(update-fn [data]
-            [data]
             (if (some? value)
               (assoc-in data [:plugin-data namespace key] value)
               (update-in data [:plugin-data namespace] (fnil dissoc {}) key)))]

common/src/app/common/geom/shapes/path.cljc

@@ -893,6 +893,7 @@
          (reduce +)
          (not= 0))))
 
+;; FIXME: this should be on upc/ namespace
 (defn split-line-to
   "Given a point and a line-to command will create a two new line-to commands
   that will split the original line into two given a value between 0-1"
@@ -901,6 +902,7 @@
         sp (gpt/lerp from-p to-p t-val)]
     [(upc/make-line-to sp) cmd]))
 
+;; FIXME: this should be on upc/ namespace
 (defn split-curve-to
   "Given the point and a curve-to command will split the curve into two new
   curve-to commands given a value between 0-1"

common/src/app/common/json.cljc

@@ -5,12 +5,11 @@
 ;; Copyright (c) KALEIDOS INC
 
 (ns app.common.json
-  (:refer-clojure :exclude [read])
+  (:refer-clojure :exclude [read clj->js js->clj])
   (:require
    #?(:clj [clojure.data.json :as j])
    [cuerdas.core :as str]))
 
-
 #?(:clj
    (defn read
      [reader & {:as opts}]
@@ -21,34 +20,6 @@
      [writer data & {:as opts}]
      (j/write data writer opts)))
 
-#?(:cljs
-   (defn map->obj
-     "A simplified version of clj->js with focus on performance"
-     [x & {:keys [key-fn]}]
-     (cond
-       (nil? x)
-       nil
-
-       (keyword? x)
-       (name x)
-
-       (map? x)
-       (reduce-kv (fn [m k v]
-                    (let [k (if (keyword? k) (name k) k)]
-                      (unchecked-set m (key-fn k) (map->obj v key-fn))
-                      m))
-                  #js {}
-                  x)
-
-       (coll? x)
-       (reduce (fn [arr v]
-                 (.push arr v)
-                 arr)
-               (array)
-               x)
-
-       :else x)))
-
 (defn read-kebab-key
   [k]
   (if (and (string? k) (not (str/includes? k "/")))
@@ -61,12 +32,75 @@
     (str/camel k)
     (str k)))
 
-#?(:clj
+#?(:cljs
+   (defn ->js
+     [x & {:keys [key-fn]
+           :or {key-fn write-camel-key} :as opts}]
+     (let [f (fn this-fn [x]
+               (cond
+                 (nil? x)
+                 nil
+
+                 (satisfies? cljs.core/IEncodeJS x)
+                 (cljs.core/-clj->js x)
+
+                 (or (keyword? x)
+                     (symbol? x))
+                 (name x)
+
+                 (number? x)
+                 x
+
+                 (boolean? x)
+                 x
+
+                 (map? x)
+                 (reduce-kv (fn [m k v]
+                              (let [k (key-fn k)]
+                                (unchecked-set m k (this-fn v))
+                                m))
+                            #js {}
+                            x)
+
+                 (coll? x)
+                 (reduce (fn [arr v]
+                           (.push arr (this-fn v))
+                           arr)
+                         (array)
+                         x)
+
+                 :else
+                 (str x)))]
+       (f x))))
+
+#?(:cljs
+   (defn ->clj
+     [o & {:keys [key-fn val-fn] :or {key-fn read-kebab-key val-fn identity}}]
+     (let [f (fn this-fn [x]
+               (let [x (val-fn x)]
+                 (cond
+                   (array? x)
+                   (persistent!
+                    (.reduce ^js/Array x
+                             #(conj! %1 (this-fn %2))
+                             (transient [])))
+
+                   (identical? (type x) js/Object)
+                   (persistent!
+                    (.reduce ^js/Array (js-keys x)
+                             #(assoc! %1 (key-fn %2) (this-fn (unchecked-get x %2)))
+                             (transient {})))
+
+                   :else
+                   x)))]
+       (f o))))
+
 (defn encode
   [data & {:as opts}]
-     (j/write-str data opts)))
+  #?(:clj (j/write-str data opts)
+     :cljs (.stringify js/JSON (->js data opts))))
 
-#?(:clj
 (defn decode
   [data & {:as opts}]
-     (j/read-str data opts)))
+  #?(:clj (j/read-str data opts)
+     :cljs (->clj (.parse js/JSON data) opts)))

common/src/app/common/schema.cljc

@@ -895,11 +895,11 @@
     :description "Satisfies Inst protocol"
     :error/message "should be an instant"
     :gen/gen (->> (sg/small-int)
-                  (sg/fmap (fn [v] (tm/instant v))))
+                  (sg/fmap (fn [v] (tm/parse-instant v))))
 
-    :decode/string tm/instant
+    :decode/string tm/parse-instant
     :encode/string tm/format-instant
-    :decode/json tm/instant
+    :decode/json tm/parse-instant
     :encode/json tm/format-instant
     ::oapi/type "string"
     ::oapi/format "iso"}})

common/src/app/common/time.cljc

@@ -27,11 +27,22 @@
   #?(:clj (Instant/now)
      :cljs (.local ^js DateTime)))
 
-(defn instant
+(defn instant?
+  [o]
+  #?(:clj (instance? Instant o)
+     :cljs (instance? DateTime o)))
+
+(defn parse-instant
   [s]
-  (if (int? s)
+  (cond
+    (instant? s)
+    s
+
+    (int? s)
     #?(:clj  (Instant/ofEpochMilli s)
        :cljs (.fromMillis ^js DateTime s #js {:zone "local" :setZone false}))
+
+    (string? s)
     #?(:clj (Instant/parse s)
        :cljs (.fromISO ^js DateTime s))))
 

frontend/src/app/main/fonts.cljs

@@ -242,8 +242,8 @@
 
 (defn ready
   [cb]
-  (-> (obj/get-in js/document ["fonts" "ready"])
+  (let [fonts (obj/get js/document "fonts")]
-      (p/then cb)))
+    (p/then (obj/get fonts "ready") cb)))
 
 (defn get-default-variant
   [{:keys [variants]}]

frontend/src/app/main/ui/components/dropdown_menu.cljs

@@ -96,14 +96,17 @@
     [:ul {:class list-class :role "menu"} children]))
 
 (mf/defc dropdown-menu
-  {::mf/wrap-props false}
+  {::mf/props :obj}
   [props]
   (assert (fn? (gobj/get props "on-close")) "missing `on-close` prop")
   (assert (boolean? (gobj/get props "show")) "missing `show` prop")
 
   (let [ids (obj/get props "ids")
-        ids (d/nilv ids (->> (obj/get props "children")
+        ids (or ids
-                             (keep #(obj/get-in % ["props" "id"]))))]
+                (->> (obj/get props "children")
+                     (keep (fn [o]
+                             (let [props (obj/get o "props")]
+                               (obj/get props "id"))))))]
     (when (gobj/get props "show")
       (mf/element
        dropdown-menu'

frontend/src/app/main/ui/components/forms.cljs

@@ -16,10 +16,10 @@
    [app.util.forms :as fm]
    [app.util.i18n :as i18n :refer [tr]]
    [app.util.keyboard :as kbd]
-   [app.util.object :as obj]
    [cljs.core :as c]
    [cuerdas.core :as str]
-   [rumext.v2 :as mf]))
+   [rumext.v2 :as mf]
+   [rumext.v2.util :as mfu]))
 
 (def form-ctx (mf/create-context nil))
 (def use-form fm/use-form)
@@ -102,7 +102,7 @@
                   (cond-> (and value is-checkbox?) (assoc :default-checked value))
                   (cond-> (and touched? (:message error)) (assoc "aria-invalid" "true"
                                                                  "aria-describedby" (dm/str "error-" input-name)))
-                  (obj/map->obj obj/prop-key-fn))
+                  (mfu/map->props))
 
         checked? (and is-checkbox? (= value true))
         show-valid? (and show-success? touched? (not error))
@@ -205,7 +205,7 @@
                          :on-blur on-blur
                          ;; :placeholder label
                          :on-change on-change)
-                  (obj/map->obj obj/prop-key-fn))]
+                  (mfu/map->props))]
 
     [:div {:class (dm/str klass " " (stl/css :textarea-wrapper))}
      [:label {:class (stl/css :textarea-label)} label]

frontend/src/app/main/ui/shapes/attrs.cljs

@@ -11,6 +11,7 @@
    [app.common.data.macros :as dm]
    [app.common.files.helpers :as cfh]
    [app.common.geom.shapes :as gsh]
+   [app.common.json :as json]
    [app.common.svg :as csvg]
    [app.common.types.shape :refer [stroke-caps-line stroke-caps-marker]]
    [app.common.types.shape.radius :as ctsr]
@@ -154,6 +155,7 @@
   [shape render-id]
   (let [attrs (get shape :svg-attrs {})
         defs  (get shape :svg-defs {})]
+
     (if (and (empty? defs)
              (empty? attrs))
       #js {}
@@ -164,7 +166,7 @@
                (dm/str render-id "-" id)
                id)))
           (dissoc :id)
-          (obj/map->obj)))))
+          (json/->js :key-fn name)))))
 
 (defn get-fill-style
   ([fill-data index render-id type]

frontend/src/app/main/ui/shapes/export.cljs

@@ -12,9 +12,9 @@
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.geom.shapes :as gsh]
+   [app.common.json :as json]
    [app.common.svg :as csvg]
    [app.main.ui.context :as muc]
-   [app.util.json :as json]
    [app.util.object :as obj]
    [cuerdas.core :as str]
    [rumext.v2 :as mf]))
@@ -29,9 +29,11 @@
 
   (cond
     (map? node)
-    [:> (d/name tag) (obj/map->obj (csvg/attrs->props attrs))
+    (let [props (-> (csvg/attrs->props attrs)
+                    (json/->js :key-fn name))]
+      [:> (d/name tag) props
        (for [child content]
-       [:& render-xml {:xml child :key (swap! internal-counter inc)}])]
+         [:& render-xml {:xml child :key (swap! internal-counter inc)}])])
 
     (string? node)
     node
@@ -39,14 +41,6 @@
     :else
     nil))
 
-(defn uuid->string [m]
-  (->> m
-       (d/deep-mapm
-        (fn [[k v]]
-          (if (uuid? v)
-            [k (str v)]
-            [k v])))))
-
 (defn bool->str [val]
   (when (some? val) (str val)))
 
@@ -130,8 +124,8 @@
               (add! :width)
               (add! :height)
               (add! :grow-type)
-              (add! :content (comp json/encode uuid->string))
+              (add! :content json/encode)
-              (add! :position-data (comp json/encode uuid->string))))
+              (add! :position-data json/encode)))
 
         (cond-> mask?
           (obj/set! "penpot:masked-group" "true"))

frontend/src/app/main/ui/shapes/svg_defs.cljs

@@ -12,8 +12,8 @@
    [app.common.geom.rect :as grc]
    [app.common.geom.shapes :as gsh]
    [app.common.geom.shapes.bounds :as gsb]
+   [app.common.json :as json]
    [app.common.svg :as csvg]
-   [app.util.object :as obj]
    [rumext.v2 :as mf]))
 
 (defn add-matrix [attrs transform-key transform-matrix]
@@ -79,12 +79,16 @@
                     :data-old-width (:width attrs)
                     :data-old-height (:height attrs)}))
 
-          [wrapper wrapper-props] (if (= tag :mask)
+          [wrapper wrapper-props]
+          (if (= tag :mask)
             ["g" #js {:className "svg-mask-wrapper"
                       :transform (str transform)}]
-                                    [mf/Fragment #js {}])]
+            [mf/Fragment #js {}])
 
-      [:> (name tag) (obj/map->obj attrs)
+          props
+          (json/->js attrs :key-fn name)]
+
+      [:> (name tag) props
        [:> wrapper wrapper-props
         (for [[index node] (d/enumerate content)]
           [:& svg-node {:key (dm/str "node-" index)

frontend/src/app/plugins/format.cljs

@@ -35,7 +35,7 @@
 (defn format-point
   [{:keys [x y] :as point}]
   (when (some? point)
-    (obj/clear-empty
+    (obj/without-empty
      #js {:x x :y y})))
 
 ;;export type PenpotBounds = {
@@ -47,7 +47,7 @@
 (defn format-bounds
   [{:keys [x y width height] :as bounds}]
   (when (some? bounds)
-    (obj/clear-empty
+    (obj/without-empty
      #js {:x x :y y :width width :height height})))
 
 ;; export interface PenpotColorShapeInfoEntry {
@@ -58,7 +58,7 @@
 (defn format-shape-info
   [{:keys [prop shape-id index] :as info}]
   (when (some? info)
-    (obj/clear-empty
+    (obj/without-empty
      #js {:property (d/name prop)
           :index index
           :shapeId (dm/str shape-id)})))
@@ -75,12 +75,12 @@
 (defn format-stop
   [{:keys [color opacity offset] :as stop}]
   (when (some? stop)
-    (obj/clear-empty #js {:color color :opacity opacity :offset offset})))
+    (obj/without-empty #js {:color color :opacity opacity :offset offset})))
 
 (defn format-gradient
   [{:keys [type start-x start-y end-x end-y width stops] :as gradient}]
   (when (some? gradient)
-    (obj/clear-empty
+    (obj/without-empty
      #js {:type (format-key type)
           :startX start-x
           :startY start-y
@@ -100,7 +100,7 @@
 (defn format-image
   [{:keys [name width height mtype id keep-aspect-ratio] :as image}]
   (when (some? image)
-    (obj/clear-empty
+    (obj/without-empty
      #js {:name name
           :width width
           :height height
@@ -122,7 +122,7 @@
 (defn format-color
   [{:keys [id name path color opacity ref-id ref-file gradient image] :as color-data}]
   (when (some? color-data)
-    (obj/clear-empty
+    (obj/without-empty
      #js {:id (format-id id)
           :name name
           :path path
@@ -155,7 +155,7 @@
 (defn format-shadow
   [{:keys [id style offset-x offset-y blur spread hidden color] :as shadow}]
   (when (some? shadow)
-    (obj/clear-empty
+    (obj/without-empty
      #js {:id (-> id format-id)
           :style (-> style format-key)
           :offsetX offset-x
@@ -181,7 +181,7 @@
 (defn format-fill
   [{:keys [fill-color fill-opacity fill-color-gradient fill-color-ref-file fill-color-ref-id fill-image] :as fill}]
   (when (some? fill)
-    (obj/clear-empty
+    (obj/without-empty
      #js {:fillColor fill-color
           :fillOpacity fill-opacity
           :fillColorGradient (format-gradient fill-color-gradient)
@@ -219,7 +219,7 @@
            stroke-cap-start stroke-cap-end stroke-color-gradient] :as stroke}]
 
   (when (some? stroke)
-    (obj/clear-empty
+    (obj/without-empty
      #js {:strokeColor stroke-color
           :strokeColorRefFile (format-id stroke-color-ref-file)
           :strokeColorRefId (format-id stroke-color-ref-id)
@@ -245,7 +245,7 @@
 (defn format-blur
   [{:keys [id type value hidden] :as blur}]
   (when (some? blur)
-    (obj/clear-empty
+    (obj/without-empty
      #js {:id (format-id id)
           :type (format-key type)
           :value value
@@ -259,7 +259,7 @@
 (defn format-export
   [{:keys [type scale suffix] :as export}]
   (when (some? export)
-    (obj/clear-empty
+    (obj/without-empty
      #js {:type (format-key type)
           :scale scale
           :suffix suffix})))
@@ -280,7 +280,7 @@
 (defn format-frame-guide-column-params
   [{:keys [color type size margin item-length gutter] :as params}]
   (when (some? params)
-    (obj/clear-empty
+    (obj/without-empty
      #js {:color (format-color color)
           :type (format-key type)
           :size size
@@ -296,7 +296,7 @@
 (defn format-frame-guide-column
   [{:keys [type display params] :as guide}]
   (when (some? guide)
-    (obj/clear-empty
+    (obj/without-empty
      #js {:type (format-key type)
           :display display
           :params (format-frame-guide-column-params params)})))
@@ -309,7 +309,7 @@
 (defn format-frame-guide-row
   [{:keys [type display params] :as guide}]
   (when (some? guide)
-    (obj/clear-empty
+    (obj/without-empty
      #js {:type (format-key type)
           :display display
           :params (format-frame-guide-column-params params)})))
@@ -321,7 +321,7 @@
 (defn format-frame-guide-square-params
   [{:keys [color size] :as params}]
   (when (some? params)
-    (obj/clear-empty
+    (obj/without-empty
      #js {:color (format-color color)
           :size size})))
 
@@ -334,7 +334,7 @@
 (defn format-frame-guide-square
   [{:keys [type display params] :as guide}]
   (when (some? guide)
-    (obj/clear-empty
+    (obj/without-empty
      #js {:type (format-key type)
           :display display
           :params (format-frame-guide-column-params params)})))
@@ -382,7 +382,7 @@
 (defn format-command-params
   [{:keys [x y c1x c1y c2x c2y rx ry x-axis-rotation large-arc-flag sweep-flag] :as props}]
   (when (some? props)
-    (obj/clear-empty
+    (obj/without-empty
      #js {:x x
           :y y
           :c1x c1x
@@ -398,7 +398,7 @@
 (defn format-command
   [{:keys [command params] :as props}]
   (when (some? props)
-    (obj/clear-empty
+    (obj/without-empty
      #js {:command (format-key command)
           :params (format-command-params params)})))
 
@@ -416,7 +416,7 @@
 (defn format-track
   [{:keys [type value] :as track}]
   (when (some? track)
-    (obj/clear-empty
+    (obj/without-empty
      #js {:type (-> type format-key)
           :value value})))
 
@@ -462,7 +462,7 @@
 (defn format-animation
   [animation]
   (when animation
-    (obj/clear-empty
+    (obj/without-empty
      (case (:animation-type animation)
 
        :dissolve
@@ -543,7 +543,7 @@
 (defn format-action
   [interaction plugin file-id page-id]
   (when interaction
-    (obj/clear-empty
+    (obj/without-empty
      (case (:action-type interaction)
        :navigate
        #js {:type "navigate-to"

frontend/src/app/util/object.cljs

@@ -6,12 +6,7 @@
 
 (ns app.util.object
   "A collection of helpers for work with javascript objects."
-  (:refer-clojure :exclude [set! new get get-in merge clone contains? array? into-array])
+  (:refer-clojure :exclude [set! new get merge clone contains? array? into-array]))
-  (:require
-   [cuerdas.core :as str]
-   ;; FIXME: we use goog.string here for performance reasons, pending
-   ;; to apply this optimizations directly to cuerdas.
-   [goog.string :as gstr]))
 
 (defn array?
   [o]
@@ -36,24 +31,6 @@
   (when (some? obj)
     (js/Object.hasOwn obj k)))
 
-(defn get-keys
-  [obj]
-  (js/Object.keys ^js obj))
-
-(defn get-in
-  ([obj keys]
-   (get-in obj keys nil))
-
-  ([obj keys default]
-   (loop [key (first keys)
-          keys (rest keys)
-          res obj]
-     (if (or (nil? key) (nil? res))
-       (or res default)
-       (recur (first keys)
-              (rest keys)
-              (unchecked-get res key))))))
-
 (defn clone
   [a]
   (js/Object.assign #js {} a))
@@ -80,86 +57,20 @@
   (js-delete obj key)
   obj)
 
+(def ^:private not-found-sym (js/Symbol "not-found"))
+
 (defn update!
   [obj key f & args]
-  (let [found (get obj key ::not-found)]
+  (let [found (get obj key not-found-sym)]
-    (if-not (identical? ::not-found found)
+    (when-not ^boolean (identical? found not-found-sym)
-      (do (unchecked-set obj key (apply f found args))
+      (unchecked-set obj key (apply f found args)))
-          obj)
+    obj))
-      obj)))
-
-(defn- props-key-fn
-  [k]
-  (if (or (keyword? k) (symbol? k))
-    (let [nword (name k)]
-      (cond
-        (= nword "class") "className"
-        (str/starts-with? nword "--") nword
-        (str/starts-with? nword "data-") nword
-        (str/starts-with? nword "aria-") nword
-        :else (str/camel nword)))
-    k))
-
-(defn clj->props
-  [props]
-  (clj->js props :keyword-fn props-key-fn))
 
 (defn ^boolean in?
   [obj prop]
   (js* "~{} in ~{}" prop obj))
 
-(defn- transform-prop-key
+(defn without-empty
-  [s]
-  (let [result (js* "~{}.replace(\":\", \"-\").replace(/-./g, x=>x[1].toUpperCase())", s)]
-    (if ^boolean (gstr/startsWith s "-")
-      (gstr/capitalize result)
-      result)))
-
-(defn prop-key-fn
-  [k]
-  (when (string? k)
-    (cond
-      (or (= k "class")
-          (= k "class-name"))
-      "className"
-
-      (gstr/startsWith k "data-")
-      k
-
-      :else
-      (transform-prop-key k))))
-
-
-;; FIXME: REPEATED from app.common.json
-(defn map->obj
-  "A simplified version of clj->js with focus on performance"
-  ([x] (map->obj x identity))
-  ([x ^function key-fn]
-   (cond
-     (nil? x)
-     nil
-
-     (keyword? x)
-     (name x)
-
-     (map? x)
-     (reduce-kv (fn [m k v]
-                  (let [k (if (keyword? k) (name k) k)]
-                    (unchecked-set m (key-fn k) (map->obj v key-fn))
-                    m))
-                #js {}
-                x)
-
-     (coll? x)
-     (reduce (fn [arr v]
-               (.push arr v)
-               arr)
-             (array)
-             x)
-
-     :else x)))
-
-(defn clear-empty
   [^js obj]
   (when (some? obj)
     (js* "Object.entries(~{}).reduce((a, [k,v]) => (v == null ? a : (a[k]=v, a)), {}) " obj)))

frontend/src/app/util/path/tools.cljs

@@ -12,6 +12,8 @@
    [app.common.svg.path.command :as upc]
    [clojure.set :as set]))
 
+;; FIXME: move to common, there are nothing tied to frontend
+
 (defn remove-line-curves
   "Remove all curves that have both handlers in the same position that the
   beginning and end points. This makes them really line-to commands"
@@ -28,7 +30,7 @@
                      (= cur-point handler-c2)
                      (= pre-point handler-c1))
               (assoc content index {:command :line-to
-                                    :params cur-point})
+                                    :params (into {} cur-point)})
               content)))]
 
     (reduce process-command content with-prev)))
@@ -69,10 +71,13 @@
         h2 (gpt/add to-p dv2)]
     (-> cmd
         (assoc :command :curve-to)
-        (assoc-in [:params :c1x] (:x h1))
+        (update :params (fn [params]
-        (assoc-in [:params :c1y] (:y h1))
+                          ;; ensure plain map
-        (assoc-in [:params :c2x] (:x h2))
+                          (-> (into {} params)
-        (assoc-in [:params :c2y] (:y h2)))))
+                              (assoc :c1x (:x h1))
+                              (assoc :c1y (:y h1))
+                              (assoc :c2x (:x h2))
+                              (assoc :c2y (:y h2))))))))
 
 (defn is-curve?
   [content point]
@@ -81,13 +86,18 @@
         handler-points (map #(upc/handler->point content (first %) (second %)) handlers)]
     (some #(not= point %) handler-points)))
 
+(def ^:private xf:mapcat-points
+  (comp
+   (mapcat #(vector (:next-p %) (:prev-p %)))
+   (remove nil?)))
+
 (defn make-curve-point
   "Changes the content to make the point a 'curve'. The handlers will be positioned
   in the same vector that results from the previous->next points but with fixed length."
   [content point]
 
   (let [indices (upc/point-indices content point)
-        vectors (->> indices (mapv (fn [index]
+        vectors (map (fn [index]
                        (let [cmd (nth content index)
                              prev-i (dec index)
                              prev (when (not (= :move-to (:command cmd)))
@@ -97,20 +107,19 @@
 
                              next (when (not (= :move-to (:command next)))
                                     next)]
-                                       (hash-map :index index
+                         {:index index
                           :prev-i (when (some? prev) prev-i)
                           :prev-c prev
                           :prev-p (upc/command->point prev)
                           :next-i (when (some? next) next-i)
                           :next-c next
                           :next-p (upc/command->point next)
-                                                 :command cmd)))))
+                          :command cmd}))
+                     indices)
 
-        points (->> vectors (mapcat #(vector (:next-p %) (:prev-p %))) (remove nil?) (into #{}))]
+        points (into #{} xf:mapcat-points vectors)]
 
-    (cond
+    (if (= (count points) 2)
-      (= (count points) 2)
-      ;;
       (let [v1 (gpt/to-vec (first points) point)
             v2 (gpt/to-vec (first points) (second points))
             vp (gpt/project v1 v2)
@@ -143,9 +152,9 @@
 
                   (and (= :curve-to (:command next-cmd)) (some? next-p))
                   (update next-i upc/update-handler :c1 next-h))))]
-        (->> vectors (reduce add-curve content)))
 
-      :else
+        (reduce add-curve content vectors))
+
       (let [add-curve
             (fn [content {:keys [index command prev-p next-c next-i]}]
               (cond-> content
@@ -160,7 +169,7 @@
 
                 (= :curve-to (:command next-c))
                 (update next-i #(line->curve point %))))]
-        (->> vectors (reduce add-curve content))))))
+        (reduce add-curve content vectors)))))
 
 (defn get-segments
   "Given a content and a set of points return all the segments in the path
@@ -175,18 +184,22 @@
            cur-cmd     (first content)
            content     (rest content)]
 
-      (let [;; Close-path makes a segment from the last point to the initial path point
+      (let [command     (:command cur-cmd)
-            cur-point (if (= :close-path (:command cur-cmd))
+            close-path? (= command :close-path)
+            move-to?    (= command :move-to)
+
+            ;; Close-path makes a segment from the last point to the initial path point
+            cur-point (if close-path?
                         start-point
                         (upc/command->point cur-cmd))
 
             ;; If there is a move-to we don't have a segment
-            prev-point (if (= :move-to (:command cur-cmd))
+            prev-point (if move-to?
                          nil
                          prev-point)
 
             ;; We update the start point
-            start-point (if (= :move-to (:command cur-cmd))
+            start-point (if move-to?
                           cur-point
                           start-point)
 

frontend/src/app/worker/export.cljs

@@ -7,6 +7,7 @@
 (ns app.worker.export
   (:require
    [app.common.data :as d]
+   [app.common.json :as json]
    [app.common.media :as cm]
    [app.common.text :as ct]
    [app.common.types.components-list :as ctkl]
@@ -16,7 +17,6 @@
    [app.main.render :as r]
    [app.main.repo :as rp]
    [app.util.http :as http]
-   [app.util.json :as json]
    [app.util.webapi :as wapi]
    [app.util.zip :as uz]
    [app.worker.impl :as impl]

frontend/src/app/worker/import.cljs

@@ -9,18 +9,21 @@
   (:require
    ["jszip" :as zip]
    [app.common.data :as d]
+   [app.common.exceptions :as ex]
    [app.common.files.builder :as fb]
    [app.common.geom.point :as gpt]
    [app.common.geom.shapes.path :as gpa]
+   [app.common.json :as json]
    [app.common.logging :as log]
    [app.common.media :as cm]
    [app.common.pprint :as pp]
+   [app.common.schema :as sm]
    [app.common.text :as ct]
+   [app.common.time :as tm]
    [app.common.uuid :as uuid]
    [app.main.repo :as rp]
    [app.util.http :as http]
    [app.util.i18n :as i18n :refer [tr]]
-   [app.util.json :as json]
    [app.util.sse :as sse]
    [app.util.webapi :as wapi]
    [app.util.zip :as uz]
@@ -37,6 +40,29 @@
 
 (def conjv (fnil conj []))
 
+(def ^:private iso-date-rx
+  "Incomplete ISO regex for detect datetime-like values on strings"
+  #"^\d{4}-[01]\d-[0-3]\dT[0-2]\d:[0-5]\d:[0-5]\d.*")
+
+(defn read-json-key
+  [m]
+  (or (sm/parse-uuid m)
+      (json/read-kebab-key m)))
+
+(defn read-json-val
+  [m]
+  (cond
+    (and (string? m)
+         (re-matches sm/uuid-rx m))
+    (uuid/uuid m)
+
+    (and (string? m)
+         (re-matches iso-date-rx m))
+    (or (ex/ignoring (tm/parse-instant m)) m)
+
+    :else
+    m))
+
 (defn get-file
   "Resolves the file inside the context given its id and the data"
   ([context type]
@@ -62,22 +88,22 @@
 
          parse-svg?  (and (not= type :media) (str/ends-with? path "svg"))
          parse-json? (and (not= type :media) (str/ends-with? path "json"))
-         no-parse?   (or (= type :media)
-                         (not (or parse-svg? parse-json?)))
-
          file-type   (if (or parse-svg? parse-json?) "text" "blob")]
 
      (log/debug :action "parsing" :path path)
 
-     (cond->> (uz/get-file (:zip context) path file-type)
+     (let [stream (->> (uz/get-file (:zip context) path file-type)
+                       (rx/map :content))]
+
+       (cond
          parse-svg?
-       (rx/map (comp tubax/xml->clj :content))
+         (rx/map tubax/xml->clj stream)
 
          parse-json?
-       (rx/map (comp json/decode :content))
+         (rx/map #(json/decode % :key-fn read-json-key :val-fn read-json-val) stream)
 
-       no-parse?
+         :else
-       (rx/map :content)))))
+         stream)))))
 
 (defn progress!
   ([context type]
@@ -569,7 +595,7 @@
                             (update :id resolve))]
               (fb/add-library-color file color)))]
       (->> (get-file context :colors-list)
-           (rx/merge-map (comp d/kebab-keys parser/string->uuid))
+           (rx/merge-map identity)
            (rx/mapcat
             (fn [[id color]]
               (let [color (assoc color :id id)
@@ -599,7 +625,7 @@
   (if (:has-typographies context)
     (let [resolve (:resolve context)]
       (->> (get-file context :typographies)
-           (rx/merge-map (comp d/kebab-keys parser/string->uuid))
+           (rx/merge-map identity)
            (rx/map (fn [[id typography]]
                      (-> typography
                          (d/kebab-keys)
@@ -613,7 +639,7 @@
   (if (:has-media context)
     (let [resolve (:resolve context)]
       (->> (get-file context :media-list)
-           (rx/merge-map (comp d/kebab-keys parser/string->uuid))
+           (rx/merge-map identity)
            (rx/mapcat
             (fn [[id media]]
               (let [media (-> media
@@ -725,7 +751,6 @@
                        (rx/filter (fn [data] (= "application/zip" (:type data))))
                        (rx/merge-map #(zip/loadAsync (:body %)))
                        (rx/merge-map #(get-file {:zip %} :manifest))
-                       (rx/map (comp d/kebab-keys parser/string->uuid))
                        (rx/map
                         (fn [data]
                           ;; Checks if the file is exported with components v2 and the current team only

frontend/src/debug.cljs

@@ -10,8 +10,9 @@
    [app.common.data.macros :as dm]
    [app.common.files.repair :as cfr]
    [app.common.files.validate :as cfv]
+   [app.common.json :as json]
    [app.common.logging :as l]
-   [app.common.math :as mth]
+   [app.common.schema :as sm]
    [app.common.transit :as t]
    [app.common.types.file :as ctf]
    [app.common.uri :as u]
@@ -97,26 +98,14 @@
        (effect-fn input)
        (rf result input)))))
 
-(defn prettify
-  "Prepare x for cleaner output when logged."
-  [x]
-  (cond
-    (map? x) (d/mapm #(prettify %2) x)
-    (vector? x) (mapv prettify x)
-    (seq? x) (map prettify x)
-    (set? x) (into #{} (map prettify) x)
-    (number? x) (mth/precision x 4)
-    (uuid? x) (str/concat "#uuid " x)
-    :else x))
-
 (defn ^:export logjs
   ([str] (tap (partial logjs str)))
   ([str val]
-   (js/console.log str (clj->js (prettify val) :keyword-fn (fn [v] (str/concat v))))
+   (js/console.log str (json/->js val))
    val))
 
 (when (exists? js/window)
-  (set! (.-dbg ^js js/window) clj->js)
+  (set! (.-dbg ^js js/window) json/->js)
   (set! (.-pp ^js js/window) pprint))
 
 (defonce widget-style "
@@ -479,7 +468,7 @@
                      (let [result (map (fn [row]
                                          (update row :id str))
                                        result)]
-                       (js/console.table (clj->js result))))
+                       (js/console.table (json/->js result))))
                    (fn [cause]
                      (js/console.log "EE:" cause))))
     nil))
@@ -494,7 +483,7 @@
          (rx/map http/conditional-decode-transit)
          (rx/mapcat rp/handle-response)
          (rx/subs! (fn [{:keys [id]}]
-                     (println "Snapshot saved:" (str id)))
+                     (println "Snapshot saved:" (str id) label))
                    (fn [cause]
                      (js/console.log "EE:" cause))))))
 
@@ -502,13 +491,21 @@
   [label file-id]
   (when-let [file-id (or (d/parse-uuid file-id)
                          (:current-file-id @st/state))]
+    (let [snapshot-id (sm/parse-uuid label)
+          label       (if snapshot-id nil label)
+          params      (cond-> {:file-id file-id}
+                        (uuid? snapshot-id)
+                        (assoc :id snapshot-id)
+
+                        (string? label)
+                        (assoc :label label))]
       (->> (http/send! {:method :post
                         :uri (u/join cf/public-uri "api/rpc/command/restore-file-snapshot")
-                      :body (http/transit-data {:file-id file-id :label label})})
+                        :body (http/transit-data params)})
            (rx/map http/conditional-decode-transit)
            (rx/mapcat rp/handle-response)
            (rx/subs! (fn [_]
-                     (println "Snapshot restored " label)
+                       (println "Snapshot restored " (or snapshot-id label)))
                      #_(.reload js/location))
            (fn [cause]
              (js/console.log "EE:" cause))))))