🐛 Fix incorrect unicode code points handling on draft-to-penpot conversion.

common/app/common/text.cljc

@@ -7,6 +7,7 @@
 (ns app.common.text
   (:require
    [app.common.attrs :as attrs]
+   [app.common.uuid :as uuid]
    [app.common.data :as d]
    [app.util.transit :as t]
    [clojure.walk :as walk]
@@ -74,3 +75,195 @@
 (defn ^boolean is-root-node?
   [node]
   (= "root" (:type node)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; DraftJS <-> Penpot Conversion
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn encode-style-value
+  [v]
+  (cond
+    (uuid? v)    (str "u:" v)
+    (string? v)  (str "s:" v)
+    (number? v)  (str "n:" v)
+    (keyword? v) (str "k:" (name v))
+    (map? v)     (str "m:" (t/encode v))
+    (nil? v)     (str "z:null")
+    :else (str "o:" v)))
+
+(defn decode-style-value
+  [v]
+  (let [prefix (subs v 0 2)]
+    (case prefix
+      "s:" (subs v 2)
+      "n:" (js/Number (subs v 2))
+      "k:" (keyword (subs v 2))
+      "m:" (t/decode (subs v 2))
+      "u:" (uuid/uuid (subs v 2))
+      "z:" nil
+      "o:" (subs v 2)
+      v)))
+
+(defn encode-style
+  [key val]
+  (let [k (d/name key)
+        v (encode-style-value val)]
+    (str "PENPOT$$$" k "$$$" v)))
+
+(defn decode-style
+  [style]
+  (let [[_ k v] (str/split style "$$$" 3)]
+    [(keyword k) (decode-style-value v)]))
+
+(defn attrs-to-styles
+  [attrs]
+  (reduce-kv (fn [res k v]
+               (conj res (encode-style k v)))
+             #{}
+             attrs))
+
+(defn styles-to-attrs
+  [styles]
+  (persistent!
+   (reduce (fn [result style]
+             (if (str/starts-with? style "PENPOT")
+               (if (= style "PENPOT_SELECTION")
+                 (assoc! result :penpot-selection true)
+                 (let [[_ k v] (str/split style "$$$" 3)]
+                   (assoc! result (keyword k) (decode-style-value v))))
+               result))
+           (transient {})
+           (seq styles))))
+
+(defn- parse-draft-styles
+  "Parses draft-js style ranges, converting encoded style name into a
+  key/val pair of data."
+  [styles]
+  (->> styles
+       (filter #(str/starts-with? (get % :style) "PENPOT$$$"))
+       (map (fn [item]
+              (let [[_ k v] (-> (get item :style)
+                                (str/split "$$$" 3))]
+                {:key (keyword k)
+                 :val (decode-style-value v)
+                 :offset (get item :offset)
+                 :length (get item :length)})))))
+
+(defn- build-style-index
+  "Generates a character based index with associated styles map."
+  [length ranges]
+  (loop [result (->> (range length)
+                     (mapv (constantly {}))
+                     (transient))
+         ranges (seq ranges)]
+    (if-let [{:keys [offset length] :as item} (first ranges)]
+      (recur (reduce (fn [result index]
+                       (let [prev (get result index)]
+                         (assoc! result index (assoc prev (:key item) (:val item)))))
+                     result
+                     (range offset (+ offset length)))
+             (rest ranges))
+      (persistent! result))))
+
+(defn- text->code-points
+  [text]
+  #?(:cljs (into [] (js/Array.from text))
+     :clj  (into [] (iterator-seq (.iterator (.codePoints ^String text))))))
+
+(defn- code-points->text
+  [cpoints start end]
+  #?(:cljs (apply str (subvec cpoints start end))
+     :clj  (let [sb (StringBuilder. (- end start))]
+             (run! #(.appendCodePoint sb (int %)) (subvec cpoints start end))
+             (.toString sb))))
+
+(defn convert-from-draft
+  [content]
+  (letfn [(extract-text [cpoints part]
+            (let [start (ffirst part)
+                  end   (inc (first (last part)))
+                  text  (code-points->text cpoints start end)
+                  attrs (second (first part))]
+              (assoc attrs :text text)))
+
+          (split-texts [text styles]
+            (let [cpoints  (text->code-points text)
+                  children (->> (parse-draft-styles styles)
+                                (build-style-index (count cpoints))
+                                (d/enumerate)
+                                (partition-by second)
+                                (mapv #(extract-text cpoints %)))]
+              (cond-> children
+                (empty? children)
+                (conj {:text ""}))))
+
+          (build-paragraph [block]
+            (let [key    (get block :key)
+                  text   (get block :text)
+                  styles (get block :inlineStyleRanges)
+                  data   (get block :data)]
+              (-> data
+                  (assoc :key key)
+                  (assoc :type "paragraph")
+                  (assoc :children (split-texts text styles)))))]
+
+    {:type "root"
+     :children
+     [{:type "paragraph-set"
+       :children (->> (get content :blocks)
+                      (mapv build-paragraph))}]}))
+
+(defn convert-to-draft
+  [root]
+  (letfn [(process-attr [children ranges [k v]]
+            (loop [children (seq children)
+                   start    nil
+                   offset   0
+                   ranges   ranges]
+              (if-let [{:keys [text] :as item} (first children)]
+                (let [cpoints (text->code-points text)]
+                  (if (= v (get item k ::novalue))
+                    (recur (rest children)
+                           (if (nil? start) offset start)
+                           (+ offset (count cpoints))
+                           ranges)
+                    (if (some? start)
+                      (recur (rest children)
+                             nil
+                             (+ offset (count cpoints))
+                             (conj! ranges {:offset start
+                                            :length (- offset start)
+                                            :style (encode-style k v)}))
+                      (recur (rest children)
+                             start
+                             (+ offset (count cpoints))
+                             ranges))))
+                (cond-> ranges
+                  (some? start)
+                  (conj! {:offset start
+                          :length (- offset start)
+                          :style (encode-style k v)})))))
+
+          (calc-ranges [{:keys [children] :as blok}]
+            (let [xform (comp (map #(dissoc % :key :text))
+                              (remove empty?)
+                              (mapcat vec)
+                              (distinct))
+                  proc  #(process-attr children %1 %2)]
+              (persistent!
+               (transduce xform proc (transient []) children))))
+
+          (build-block [{:keys [key children] :as paragraph}]
+            {:key key
+             :depth 0
+             :text (apply str (map :text children))
+             :data (dissoc paragraph :key :children :type)
+             :type "unstyled"
+             :entityRanges []
+             :inlineStyleRanges (calc-ranges paragraph)})]
+
+    {:blocks (reduce #(conj %1 (build-block %2)) [] (node-seq #(= (:type %) "paragraph") root))
+     :entityMap {}}))
+
+
+

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

@@ -9,6 +9,7 @@
    ["draft-js" :as draft]
    [app.common.data :as d]
    [app.common.geom.shapes :as gsh]
+   [app.common.text :as txt]
    [app.main.data.workspace :as dw]
    [app.main.data.workspace.common :as dwc]
    [app.main.data.workspace.selection :as dws]
@@ -154,7 +155,7 @@
        :handle-return handle-return
        :strip-pasted-styles true
        :custom-style-fn (fn [styles _]
-                          (-> (ted/styles-to-attrs styles)
+                          (-> (txt/styles-to-attrs styles)
                               (sts/generate-text-styles)))
        :block-renderer-fn #(render-block % shape)
        :ref on-editor

frontend/src/app/util/text_editor.cljs

@@ -19,190 +19,12 @@
    [clojure.walk :as walk]
    [cuerdas.core :as str]))
 
-;; --- INLINE STYLES ENCODING
-
-(defn encode-style-value
-  [v]
-  (cond
-    (uuid? v)    (str "u:" v)
-    (string? v)  (str "s:" v)
-    (number? v)  (str "n:" v)
-    (keyword? v) (str "k:" (name v))
-    (map? v)     (str "m:" (t/encode v))
-    (nil? v)     (str "z:null")
-    :else (str "o:" v)))
-
-(defn decode-style-value
-  [v]
-  (let [prefix (subs v 0 2)]
-    (case prefix
-      "s:" (subs v 2)
-      "n:" (js/Number (subs v 2))
-      "k:" (keyword (subs v 2))
-      "m:" (t/decode (subs v 2))
-      "u:" (uuid/uuid (subs v 2))
-      "z:" nil
-      "o:" (subs v 2)
-      v)))
-
-(defn encode-style
-  [key val]
-  (let [k (d/name key)
-        v (encode-style-value val)]
-    (str "PENPOT$$$" k "$$$" v)))
-
-(defn encode-style-prefix
-  [key]
-  (let [k (d/name key)]
-    (str "PENPOT$$$" k "$$$")))
-
-(defn decode-style
-  [style]
-  (let [[_ k v] (str/split style "$$$" 3)]
-    [(keyword k) (decode-style-value v)]))
-
-(defn attrs-to-styles
-  [attrs]
-  (reduce-kv (fn [res k v]
-               (conj res (encode-style k v)))
-             #{}
-             attrs))
-
-(defn styles-to-attrs
-  [styles]
-  (persistent!
-   (reduce (fn [result style]
-             (if (str/starts-with? style "PENPOT")
-               (if (= style "PENPOT_SELECTION")
-                 (assoc! result :penpot-selection true)
-                 (let [[_ k v] (str/split style "$$$" 3)]
-                   (assoc! result (keyword k) (decode-style-value v))))
-               result))
-           (transient {})
-           (seq styles))))
-
 ;; --- CONVERSION
 
-(defn- parse-draft-styles
-  "Parses draft-js style ranges, converting encoded style name into a
-  key/val pair of data."
-  [styles]
-  (->> styles
-       (filter #(str/starts-with? (obj/get % "style") "PENPOT$$$"))
-       (map (fn [item]
-              (let [[_ k v] (-> (obj/get item "style")
-                                (str/split "$$$" 3))]
-                {:key (keyword k)
-                 :val (decode-style-value v)
-                 :offset (obj/get item "offset")
-                 :length (obj/get item "length")})))))
-
-(defn- build-style-index
-  "Generates a character based index with associated styles map."
-  [text ranges]
-  (loop [result (->> (range (count text))
-                     (mapv (constantly {}))
-                     (transient))
-         ranges (seq ranges)]
-    (if-let [{:keys [offset length] :as item} (first ranges)]
-      (recur (reduce (fn [result index]
-                       (let [prev (get result index)]
-                         (assoc! result index (assoc prev (:key item) (:val item)))))
-                     result
-                     (range offset (+ offset length)))
-             (rest ranges))
-      (persistent! result))))
-
-(defn- convert-from-draft
-  [content]
-  (letfn [(build-text [text part]
-            (let [start (ffirst part)
-                  end   (inc (first (last part)))]
-              (-> (second (first part))
-                  (assoc :text (subs text start end)))))
-
-          (split-texts [text styles]
-            (let [children (->> (parse-draft-styles styles)
-                                (build-style-index text)
-                                (d/enumerate)
-                                (partition-by second)
-                                (mapv #(build-text text %)))]
-              (cond-> children
-                (empty? children)
-                (conj {:text ""}))))
-
-          (build-paragraph [block]
-            (let [key    (obj/get block "key")
-                  text   (obj/get block "text")
-                  styles (obj/get block "inlineStyleRanges")
-                  data   (obj/get block "data")]
-              (-> (js->clj data :keywordize-keys true)
-                  (assoc :key key)
-                  (assoc :type "paragraph")
-                  (assoc :children (split-texts text styles)))))]
-    {:type "root"
-     :children
-     [{:type "paragraph-set"
-       :children (->> (obj/get content "blocks")
-                      (mapv build-paragraph))}]}))
-
-(defn- convert-to-draft
-  [root]
-  (letfn [(process-attr [children ranges [k v]]
-            (loop [children (seq children)
-                   start    nil
-                   offset   0
-                   ranges   ranges]
-              (if-let [{:keys [text] :as item} (first children)]
-                (if (= v (get item k ::novalue))
-                  (recur (rest children)
-                         (if (nil? start) offset start)
-                         (+ offset (alength text))
-                         ranges)
-                  (if (some? start)
-                    (recur (rest children)
-                           nil
-                           (+ offset (alength text))
-                           (arr/conj! ranges #js {:offset start
-                                                  :length (- offset start)
-                                                  :style (encode-style k v)}))
-                    (recur (rest children)
-                           start
-                           (+ offset (alength text))
-                           ranges)))
-                (cond-> ranges
-                  (some? start)
-                  (arr/conj! #js {:offset start
-                                  :length (- offset start)
-                                  :style (encode-style k v)})))))
-
-          (calc-ranges [{:keys [children] :as blok}]
-            (let [xform (comp (map #(dissoc % :key :text))
-                              (remove empty?)
-                              (mapcat vec)
-                              (distinct))
-                  proc  #(process-attr children %1 %2)]
-              (transduce xform proc #js [] children)))
-
-          (build-block [result {:keys [key children] :as paragraph}]
-            (->> #js {:key key
-                      :depth 0
-                      :text (apply str (map :text children))
-                      :data (-> (dissoc paragraph :key :children :type)
-                                (clj->js))
-                      :type "unstyled"
-                      :entityRanges #js []
-                      :inlineStyleRanges (calc-ranges paragraph)}
-                 (arr/conj! result)))]
-
-    #js {:blocks (reduce build-block #js [] (txt/node-seq #(= (:type %) "paragraph") root))
-         :entityMap #js {}}))
-
 (defn immutable-map->map
   [obj]
   (into {} (map (fn [[k v]] [(keyword k) v])) (seq obj)))
 
-
 ;; --- DRAFT-JS HELPERS
 
 (defn create-editor-state
@@ -219,13 +41,14 @@
 
 (defn import-content
   [content]
-  (-> content convert-to-draft draft/convertFromRaw))
+  (-> content txt/convert-to-draft clj->js draft/convertFromRaw))
 
 (defn export-content
   [content]
   (-> content
       (draft/convertToRaw)
-      (convert-from-draft)))
+      (js->clj :keywordize-keys true)
+      (txt/convert-from-draft)))
 
 (defn get-editor-current-content
   [state]
@@ -256,7 +79,7 @@
 (defn get-editor-current-inline-styles
   [state]
   (-> (.getCurrentInlineStyle ^js state)
-      (styles-to-attrs)))
+      (txt/styles-to-attrs)))
 
 (defn update-editor-current-block-data
   [state attrs]
@@ -264,7 +87,7 @@
 
 (defn update-editor-current-inline-styles
   [state attrs]
-  (impl/applyInlineStyle state (attrs-to-styles attrs)))
+  (impl/applyInlineStyle state (txt/attrs-to-styles attrs)))
 
 (defn editor-split-block
   [state]

frontend/tests/app/test_draft_conversion.cljs

@@ -0,0 +1,27 @@
+(ns app.test-draft-conversion
+  (:require
+   [app.common.data :as d]
+   [app.common.text :as txt]
+   [cljs.test :as t :include-macros true]
+   [cljs.pprint :refer [pprint]]))
+
+(t/deftest test-basic-conversion-roundtrip
+  (let [text    "qwqw 🠒"
+        content {:type "root",
+                 :children
+                 [{:type "paragraph-set",
+                   :children
+                   [{:key "cfjh",
+                     :type "paragraph",
+                     :children
+                     [{:font-id "gfont-roboto",
+                       :font-family "Roboto",
+                       :font-variant-id "regular",
+                       :font-weight "400",
+                       :font-style "normal",
+                       :text text}]}]}]}]
+    (cljs.pprint/pprint (txt/convert-to-draft content))
+    (cljs.pprint/pprint (txt/convert-from-draft (txt/convert-to-draft content)))
+    (t/is (= (txt/convert-from-draft (txt/convert-to-draft content))
+             content))))
+

frontend/tests/app/test_helpers/pages.cljs

@@ -1,16 +1,17 @@
 (ns app.test-helpers.pages
-  (:require [cljs.test :as t :include-macros true]
-            [cljs.pprint :refer [pprint]]
-            [beicon.core :as rx]
-            [potok.core :as ptk]
-            [app.common.uuid :as uuid]
-            [app.common.geom.point :as gpt]
-            [app.common.geom.shapes :as gsh]
-            [app.common.pages :as cp]
-            [app.common.pages.helpers :as cph]
-            [app.main.data.workspace :as dw]
-            [app.main.data.workspace.groups :as dwg]
-            [app.main.data.workspace.libraries-helpers :as dwlh]))
+  (:require
+   [cljs.test :as t :include-macros true]
+   [cljs.pprint :refer [pprint]]
+   [beicon.core :as rx]
+   [potok.core :as ptk]
+   [app.common.uuid :as uuid]
+   [app.common.geom.point :as gpt]
+   [app.common.geom.shapes :as gsh]
+   [app.common.pages :as cp]
+   [app.common.pages.helpers :as cph]
+   [app.main.data.workspace :as dw]
+   [app.main.data.workspace.groups :as dwg]
+   [app.main.data.workspace.libraries-helpers :as dwlh]))
 
 ;; ---- Helpers to manage pages and objects
 
@@ -84,7 +85,7 @@
          shapes (dwg/shapes-for-grouping (:objects page) ids)
 
          [group rchanges uchanges]
-         (dwg/prepare-create-group (:id page) shapes prefix true)]
+         (dwg/prepare-create-group (:objects page) (:id page) shapes prefix true)]
 
      (swap! idmap assoc label (:id group))
      (update state :workspace-data