Merge pull request #5034 from penpot/superalex-track-copy-shared-link-event

✨ Track copy shared link event

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

@@ -154,12 +154,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"}

common/src/app/common/json.cljc

@@ -0,0 +1,106 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.common.json
+  (: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}]
+     (j/read reader opts)))
+
+#?(:clj
+   (defn write
+     [writer data & {:as opts}]
+     (j/write data writer opts)))
+
+(defn read-kebab-key
+  [k]
+  (if (and (string? k) (not (str/includes? k "/")))
+    (-> k str/kebab keyword)
+    k))
+
+(defn write-camel-key
+  [k]
+  (if (or (keyword? k) (symbol? k))
+    (str/camel k)
+    (str k)))
+
+#?(: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}]
+  #?(:clj (j/write-str data opts)
+     :cljs (.stringify js/JSON (->js data opts))))
+
+(defn decode
+  [data & {:as opts}]
+  #?(:clj (j/read-str data opts)
+     :cljs (->clj (.parse js/JSON data) opts)))

common/src/app/common/schema.cljc

@@ -619,20 +619,27 @@
                  {:title "contains"
                   :description "contains predicate"}}))})
 
-(define! ::inst
+(def type:inst
   {:type ::inst
    :pred inst?
    :type-properties
    {:title "inst"
     :description "Satisfies Inst protocol"
-    :error/message "expected to be number in safe range"
+    :error/message "should be an instant"
     :gen/gen (->> (sg/small-int)
-                  (sg/fmap (fn [v] (tm/instant v))))
-    ::oapi/type "number"
-    ::oapi/format "int64"}})
+                  (sg/fmap (fn [v] (tm/parse-instant v))))
 
-(define! ::fn
-  [:schema fn?])
+    :decode/string tm/parse-instant
+    :encode/string tm/format-instant
+    :decode/json tm/parse-instant
+    :encode/json tm/format-instant
+    ::oapi/type "string"
+    ::oapi/format "iso"}})
+
+(register! ::inst type:inst)
+
+(register! ::fn
+           [:schema fn?])
 
 (define! ::word-string
   {:type ::word-string

common/src/app/common/time.cljc

@@ -12,6 +12,7 @@
       ["luxon" :as lxn])
      :clj
      (:import
+      java.time.format.DateTimeFormatter
       java.time.Instant
       java.time.Duration)))
 
@@ -26,10 +27,29 @@
   #?(:clj (Instant/now)
      :cljs (.local ^js DateTime)))
 
-(defn instant
+(defn instant?
+  [o]
+  #?(:clj (instance? Instant o)
+     :cljs (instance? DateTime o)))
+
+(defn parse-instant
   [s]
-  #?(:clj  (Instant/ofEpochMilli s)
-     :cljs (.fromMillis ^js DateTime s #js {:zone "local" :setZone false})))
+  (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))))
+
+(defn format-instant
+  [v]
+  #?(:clj (.format DateTimeFormatter/ISO_INSTANT ^Instant v)
+     :cljs (.toISO ^js v)))
 
 #?(:cljs
    (extend-protocol IComparable

frontend/src/app/main/ui/viewer/share_link.cljs

@@ -126,7 +126,7 @@
           (let [params (prepare-params options)
                 params (assoc params :file-id (:id file))]
             (st/emit! (dc/create-share-link params)
-                      (ptk/event ::ev/event {::ev/name "create-shared-link"
+                      (ptk/event ::ev/event {::ev/name "create-share-link"
                                              ::ev/origin "viewer"
                                              :can-comment (:who-comment params)
                                              :can-inspect-code (:who-inspect params)}))))
@@ -137,7 +137,9 @@
           (st/emit! (msg/show {:type :info
                                :notification-type :toast
                                :content (tr "common.share-link.link-copied-success")
-                               :timeout 1000})))
+                               :timeout 1000})
+                    (ptk/event ::ev/event {::ev/name "copy-share-link"
+                                           ::ev/origin "viewer"})))
 
         try-delete-link
         (fn [_]

frontend/src/app/main/ui/workspace/shapes/text/viewport_texts_html.cljs

@@ -64,24 +64,25 @@
   [{:keys [grow-type id migrate] :as shape} node]
   ;; Check if we need to update the size because it's auto-width or auto-height
   ;; Update the position-data of every text fragment
-  (p/let [position-data (tsp/calc-position-data id)]
-    ;; At least one paragraph needs to be inside the bounding box
-    (when (gsht/overlaps-position-data? shape position-data)
-      (st/emit! (dwt/update-position-data id position-data)))
+  (->> (tsp/calc-position-data id)
+       (p/fmap (fn [position-data]
+                 ;; At least one paragraph needs to be inside the bounding box
+                 (when (gsht/overlaps-position-data? shape position-data)
+                   (st/emit! (dwt/update-position-data id position-data)))
 
-    (when (contains? #{:auto-height :auto-width} grow-type)
-      (let [{:keys [width height]}
-            (-> (dom/query node ".paragraph-set")
-                (dom/get-bounding-rect))
+                 (when (contains? #{:auto-height :auto-width} grow-type)
+                   (let [{:keys [width height]}
+                         (-> (dom/query node ".paragraph-set")
+                             (dom/get-bounding-rect))
 
-            width (mth/ceil width)
-            height (mth/ceil height)]
-        (when (and (not (mth/almost-zero? width))
-                   (not (mth/almost-zero? height))
-                   (not migrate))
-          (st/emit! (dwt/resize-text id width height)))))
+                         width (mth/ceil width)
+                         height (mth/ceil height)]
+                     (when (and (not (mth/almost-zero? width))
+                                (not (mth/almost-zero? height))
+                                (not migrate))
+                       (st/emit! (dwt/resize-text id width height)))))
 
-    (st/emit! (dwt/clean-text-modifier id))))
+                 (st/emit! (dwt/clean-text-modifier id))))))
 
 (defn- update-text-modifier
   [{:keys [grow-type id] :as shape} node]

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

@@ -28,7 +28,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 +69,13 @@
         h2 (gpt/add to-p dv2)]
     (-> cmd
         (assoc :command :curve-to)
-        (assoc-in [:params :c1x] (:x h1))
-        (assoc-in [:params :c1y] (:y h1))
-        (assoc-in [:params :c2x] (:x h2))
-        (assoc-in [:params :c2y] (:y h2)))))
+        (update :params (fn [params]
+                          ;; ensure plain map
+                          (-> (into {} params)
+                              (assoc :c1x (:x h1))
+                              (assoc :c1y (:y h1))
+                              (assoc :c2x (:x h2))
+                              (assoc :c2y (:y h2))))))))
 
 (defn is-curve?
   [content 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")]
+         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)
-       parse-svg?
-       (rx/map (comp tubax/xml->clj :content))
+     (let [stream (->> (uz/get-file (:zip context) path file-type)
+                       (rx/map :content))]
 
-       parse-json?
-       (rx/map (comp json/decode :content))
+       (cond
+         parse-svg?
+         (rx/map tubax/xml->clj stream)
 
-       no-parse?
-       (rx/map :content)))))
+         parse-json?
+         (rx/map #(json/decode % :key-fn read-json-key :val-fn read-json-val) stream)
+
+         :else
+         stream)))))
 
 (defn progress!
   ([context type]
@@ -319,7 +345,7 @@
                                (assoc :id (resolve old-id)))
                              (cond-> (< (:version context 1) 2)
                                (translate-frame type file))
-                             ;; Shapes inside the deleted component should be stored with absolute coordinates 
+                             ;; Shapes inside the deleted component should be stored with absolute coordinates
                              ;; so we calculate that with the x and y stored in the context
                              (cond-> (:x context)
                                (assoc :x (:x context)))
@@ -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,8 @@
    [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.transit :as t]
    [app.common.types.file :as ctf]
    [app.common.uri :as u]
@@ -97,26 +97,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 +467,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))