From 06684cb5dfc21b048c07fc0c7ac91e56efcef047 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Tue, 31 Mar 2026 14:57:29 +0200 Subject: [PATCH] WIP --- common/src/app/common/fressian.clj | 85 +++++++++++++------ common/src/app/common/time.cljc | 13 ++- common/src/app/common/types/token.cljc | 13 +++ common/src/app/common/types/tokens_lib.cljc | 84 +++++++++--------- .../test/common_tests/types/token_test.cljc | 29 ++++++- .../common_tests/types/tokens_lib_test.cljc | 30 ++++++- 6 files changed, 181 insertions(+), 73 deletions(-) diff --git a/common/src/app/common/fressian.clj b/common/src/app/common/fressian.clj index 7e35f3116e..98c8b1b323 100644 --- a/common/src/app/common/fressian.clj +++ b/common/src/app/common/fressian.clj @@ -118,6 +118,36 @@ (d/ordered-map) (partition-all 2 (seq kvs))))) + +(defn- adapt-write-handler + [{:keys [name class wfn]}] + [class {name (reify WriteHandler + (write [_ w o] + (wfn name w o)))}]) + +(defn- adapt-read-handler + [{:keys [name rfn]}] + [name (reify ReadHandler + (read [_ rdr _ _] + (rfn rdr)))]) + +(defn- merge-handlers + [m1 m2] + (-> (merge m1 m2) + (d/without-nils))) + +(def ^:private + xf:adapt-write-handler + (comp + (filter :wfn) + (map adapt-write-handler))) + +(def ^:private + xf:adapt-read-handler + (comp + (filter :rfn) + (map adapt-read-handler))) + (def ^:dynamic *write-handler-lookup* nil) (def ^:dynamic *read-handler-lookup* nil) @@ -126,36 +156,39 @@ (defn add-handlers! [& handlers] - (letfn [(adapt-write-handler [{:keys [name class wfn]}] - [class {name (reify WriteHandler - (write [_ w o] - (wfn name w o)))}]) + (let [write-handlers' + (into {} xf:adapt-write-handler handlers) - (adapt-read-handler [{:keys [name rfn]}] - [name (reify ReadHandler - (read [_ rdr _ _] - (rfn rdr)))]) + read-handlers' + (into {} xf:adapt-read-handler handlers) - (merge-and-clean [m1 m2] - (-> (merge m1 m2) - (d/without-nils)))] + write-handlers' + (swap! write-handlers merge-handlers write-handlers') - (let [whs (into {} - (comp - (filter :wfn) - (map adapt-write-handler)) - handlers) - rhs (into {} - (comp - (filter :rfn) - (map adapt-read-handler)) - handlers) - cwh (swap! write-handlers merge-and-clean whs) - crh (swap! read-handlers merge-and-clean rhs)] + read-handlers' + (swap! read-handlers merge-handlers read-handlers')] - (alter-var-root #'*write-handler-lookup* (constantly (-> cwh fres/associative-lookup fres/inheritance-lookup))) - (alter-var-root #'*read-handler-lookup* (constantly (-> crh fres/associative-lookup))) - nil))) + (alter-var-root #'*write-handler-lookup* + (constantly + (-> write-handlers' fres/associative-lookup fres/inheritance-lookup))) + + (alter-var-root #'*read-handler-lookup* + (constantly (-> read-handlers' fres/associative-lookup))) + + nil)) + +(defn overwrite-read-handlers + [& handlers] + (->> (into {} xf:adapt-read-handler handlers) + (merge-handlers @read-handlers) + (fres/associative-lookup))) + +(defn overwrite-write-handlers + [& handlers] + (->> (into {} xf:adapt-write-handler handlers) + (merge-handlers @write-handlers) + (fres/associative-lookup) + (fres/inheritance-lookup))) (defn write-char [n w o] diff --git a/common/src/app/common/time.cljc b/common/src/app/common/time.cljc index 3784cba8a5..d73225008c 100644 --- a/common/src/app/common/time.cljc +++ b/common/src/app/common/time.cljc @@ -90,13 +90,22 @@ (Clock/fixed ^Instant (inst instant) ^ZoneId (ZoneId/of "Z")))) - - (defn now [] #?(:clj (Instant/now *clock*) :cljs (new js/Date))) +#?(:clj + (defn tick-millis-clock + "Alternate clock with a resolution of milliseconds instead of the default nanoseconds of the Java clock. + This may be useful if the instant is going to be serialized to DB with fressian (that does not have + resolution enough to store all precission) and need to compare the deserialized value for equality. + + You can replace the global clock (for example in unit tests) with + (alter-var-root #'ct/*clock* (constantly (ct/tick-millis-clock)))" + [] + (Clock/tickMillis (ZoneId/of "Z")))) + ;; --- DURATION (defn- resolve-temporal-unit diff --git a/common/src/app/common/types/token.cljc b/common/src/app/common/types/token.cljc index 55ecc842e7..2766baed5e 100644 --- a/common/src/app/common/types/token.cljc +++ b/common/src/app/common/types/token.cljc @@ -144,6 +144,19 @@ :gen/gen sg/text} token-name-validation-regex]) +(defn clean-token-name + "Remove all forbidden characters from token name and return a valid token name. + This is used for repairing invalid token names in old versions of Penpot." + [name] + (-> name + (str/replace "/" ".") + (str/replace " " "") + (str/replace #"^\$+" "") + (str/replace #"^\.+" "") + (str/replace #"\.+$" "") + (str/replace #"\.\.+" ".") + (str/replace #"[^a-zA-Z0-9$._-]" "?"))) + (def token-ref-validation-regex #"^\{[a-zA-Z0-9_-][a-zA-Z0-9$_-]*(\.[a-zA-Z0-9$_-]+)*\}$") diff --git a/common/src/app/common/types/tokens_lib.cljc b/common/src/app/common/types/tokens_lib.cljc index 63cd87e393..4dec7182f4 100644 --- a/common/src/app/common/types/tokens_lib.cljc +++ b/common/src/app/common/types/tokens_lib.cljc @@ -242,17 +242,19 @@ (update-token- [this token-id f] (assert (uuid? token-id) "expected uuid for `token-id`") (if-let [token (get-token- this token-id)] - (let [token' (-> (make-token (f token)) - (assoc :modified-at (ct/now)))] - (TokenSet. id - name - description - (ct/now) - (if (= (:name token) (:name token')) - (assoc tokens (:name token') token') - (-> tokens - (d/oassoc-before (:name token) (:name token') token') - (dissoc (:name token)))))) + (let [token' (f token)] + (if (not= token token') + (let [token' (assoc token' :modified-at (ct/now))] + (TokenSet. id + name + description + (ct/now) + (if (= (:name token) (:name token')) + (assoc tokens (:name token') token') + (-> tokens + (d/oassoc-before (:name token) (:name token') token') + (dissoc (:name token)))))) + this)) this)) (delete-token- [this token-id] @@ -303,6 +305,35 @@ (-clj->js [this] (clj->js (datafy this))))) +(def ^:private set-prefix "S-") + +(def ^:private set-group-prefix "G-") + +(def ^:private set-separator "/") + +(defn get-set-path + [token-set] + (cpn/split-path (get-name token-set) :separator set-separator)) + +(defn split-set-name + [name] + (cpn/split-path name :separator set-separator)) + +(defn join-set-path [path] + (cpn/join-path path :separator set-separator :with-spaces? false)) + +(defn normalize-set-name + "Normalize a set name (ensure that there are no extra spaces, like ' group / set' -> 'group/set'). + + If `relative-to` is provided, the normalized name will preserve the same group prefix as reference name." + ([name] + (-> (split-set-name name) + (cpn/join-path :separator set-separator :with-spaces? false))) + ([name relative-to] + (-> (concat (butlast (split-set-name relative-to)) + (split-set-name name)) + (cpn/join-path :separator set-separator :with-spaces? false)))) + (defn token-set? [o] (instance? TokenSet o)) @@ -357,6 +388,7 @@ (def check-token-set (sm/check-fn schema:token-set :hint "expected valid token set")) + (defn map->token-set [& {:as attrs}] (TokenSet. (:id attrs) @@ -372,38 +404,10 @@ (update :modified-at #(or % (ct/now))) (update :tokens #(into (d/ordered-map) %)) (update :description d/nilv "") + (update :name normalize-set-name) (check-token-set-attrs) (map->token-set))) -(def ^:private set-prefix "S-") - -(def ^:private set-group-prefix "G-") - -(def ^:private set-separator "/") - -(defn get-set-path - [token-set] - (cpn/split-path (get-name token-set) :separator set-separator)) - -(defn split-set-name - [name] - (cpn/split-path name :separator set-separator)) - -(defn join-set-path [path] - (cpn/join-path path :separator set-separator :with-spaces? false)) - -(defn normalize-set-name - "Normalize a set name (ensure that there are no extra spaces, like ' group / set' -> 'group/set'). - - If `relative-to` is provided, the normalized name will preserve the same group prefix as reference name." - ([name] - (-> (split-set-name name) - (cpn/join-path :separator set-separator :with-spaces? false))) - ([name relative-to] - (-> (concat (butlast (split-set-name relative-to)) - (split-set-name name)) - (cpn/join-path :separator set-separator :with-spaces? false)))) - (defn normalized-set-name? "Check if a set name is normalized (no extra spaces)." [name] diff --git a/common/test/common_tests/types/token_test.cljc b/common/test/common_tests/types/token_test.cljc index 96e642690c..24b429da51 100644 --- a/common/test/common_tests/types/token_test.cljc +++ b/common/test/common_tests/types/token_test.cljc @@ -10,21 +10,42 @@ [app.common.types.token :as cto] [clojure.test :as t])) -(t/deftest test-valid-token-name-schema +(t/deftest test-valid-token-name ;; Allow regular namespace token names (t/is (true? (sm/validate cto/schema:token-name "Foo"))) (t/is (true? (sm/validate cto/schema:token-name "foo"))) (t/is (true? (sm/validate cto/schema:token-name "FOO"))) (t/is (true? (sm/validate cto/schema:token-name "Foo.Bar.Baz"))) - ;; Disallow trailing tokens + ;; Allow $ inside or at the end of the name, but not at the beginning + (t/is (true? (sm/validate cto/schema:token-name "Foo$Bar$Baz"))) + (t/is (true? (sm/validate cto/schema:token-name "Foo$Bar$Baz$"))) + (t/is (false? (sm/validate cto/schema:token-name "$Foo$Bar$Baz"))) + ;; Disallow starting and trailing dots + (t/is (false? (sm/validate cto/schema:token-name "....Foo.Bar.Baz"))) (t/is (false? (sm/validate cto/schema:token-name "Foo.Bar.Baz...."))) ;; Disallow multiple separator dots (t/is (false? (sm/validate cto/schema:token-name "Foo..Bar.Baz"))) ;; Disallow any special characters (t/is (false? (sm/validate cto/schema:token-name "Hey Foo.Bar"))) - (t/is (false? (sm/validate cto/schema:token-name "Hey😈Foo.Bar"))) - (t/is (false? (sm/validate cto/schema:token-name "Hey%Foo.Bar")))) + (t/is (false? (sm/validate cto/schema:token-name "HeyÅFoo.Bar"))) + (t/is (false? (sm/validate cto/schema:token-name "Hey%Foo.Bar"))) + (t/is (false? (sm/validate cto/schema:token-name "Hey / Foo/Bar")))) +(t/deftest test-clean-token-name + (t/is (= (cto/clean-token-name "Foo") "Foo")) + (t/is (= (cto/clean-token-name "foo") "foo")) + (t/is (= (cto/clean-token-name "FOO") "FOO")) + (t/is (= (cto/clean-token-name "Foo.Bar.Baz") "Foo.Bar.Baz")) + (t/is (= (cto/clean-token-name "Foo$Bar$Baz") "Foo$Bar$Baz")) + (t/is (= (cto/clean-token-name "Foo$Bar$Baz$") "Foo$Bar$Baz$")) + (t/is (= (cto/clean-token-name "$$$Foo$Bar$Baz") "Foo$Bar$Baz")) + (t/is (= (cto/clean-token-name "....Foo.Bar.Baz") "Foo.Bar.Baz")) + (t/is (= (cto/clean-token-name "Foo.Bar.Baz....") "Foo.Bar.Baz")) + (t/is (= (cto/clean-token-name "Foo..Bar...Baz") "Foo.Bar.Baz")) + (t/is (= (cto/clean-token-name "Hey Foo Bar") "HeyFooBar")) + (t/is (= (cto/clean-token-name "HeyÅFoo.Bar") "Hey?Foo.Bar")) + (t/is (= (cto/clean-token-name "Hey%Foo.Bar") "Hey?Foo.Bar")) + (t/is (= (cto/clean-token-name "Hey / Foo/Bar") "Hey.Foo.Bar"))) (t/deftest token-value-with-refs (t/testing "empty value" diff --git a/common/test/common_tests/types/tokens_lib_test.cljc b/common/test/common_tests/types/tokens_lib_test.cljc index 23bed42897..e295efdf67 100644 --- a/common/test/common_tests/types/tokens_lib_test.cljc +++ b/common/test/common_tests/types/tokens_lib_test.cljc @@ -11,7 +11,6 @@ #?(:clj [app.common.test-helpers.tokens :as tht]) #?(:clj [clojure.datafy :refer [datafy]]) [app.common.data :as d] - [app.common.path-names :as cpn] [app.common.test-helpers.ids-map :as thi] [app.common.time :as ct] [app.common.transit :as tr] @@ -2034,3 +2033,32 @@ (t/is (true? (ctob/token-name-path-exists? "border-radius.sm.x" {"border-radius" {:name "sm"}}))) (t/is (false? (ctob/token-name-path-exists? "other" {"border-radius" {:name "sm"}}))) (t/is (false? (ctob/token-name-path-exists? "dark.border-radius.md" {"dark" {"border-radius" {"sm" {:name "sm"}}}})))) + +(t/deftest token-set-encode-decode-roundtrip-with-invalid-set-name + (binding [ct/*clock* (ct/tick-millis-clock)] + (let [tokens-lib + (-> (ctob/make-tokens-lib) + (ctob/add-set + (ctob/map->token-set + {:id (thi/new-id! :test-token-set) + :name "foo / bar" + :modified-at (ct/now) + :description ""})) + (ctob/add-token + (thi/id :test-token-set) + (ctob/make-token :name "test-token-1" + :type :boolean + :value true))) + + encoded-tokens-lib + (fres/encode tokens-lib) + + decoded-tokens-lib + (fres/decode encoded-tokens-lib)] + + (let [tset-a (ctob/get-set tokens-lib (thi/id :test-token-set)) + tset-b (ctob/get-set decoded-tokens-lib (thi/id :test-token-set))] + (t/is (= (ctob/get-name tset-a) "foo / bar")) + (t/is (= (ctob/get-name tset-b) "foo/bar")))))) + +