Merge pull request #6101 from penpot/niwinz-develop-token-fixes-4

 Add several improvements to tokens (part 4)
This commit is contained in:
Andrey Antukh 2025-03-19 13:38:46 +01:00 committed by GitHub
commit 62e89258e4
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
9 changed files with 235 additions and 161 deletions

View file

@ -10,6 +10,7 @@
(:require
[app.binfile.common :as bfc]
[app.common.data :as d]
[app.common.files.migrations :as fmg]
[app.common.files.validate :as cfv]
[app.db :as db]
[app.features.components-v2 :as feat.comp-v2]
@ -142,7 +143,9 @@
(update-fn file opts)))]
(when (and (some? file')
(not (identical? file file')))
(or (fmg/migrated? file)
(not (identical? file file'))))
(when validate?
(cfv/validate-file-schema! file'))

View file

@ -382,13 +382,13 @@
[:set-group-path [:vector :string]]
[:set-group-fname :string]]]
[:move-token-set-before
[:map {:title "MoveTokenSetBefore"}
[:type [:= :move-token-set-before]]
[:move-token-set
[:map {:title "MoveTokenSet"}
[:type [:= :move-token-set]]
[:from-path [:vector :string]]
[:to-path [:vector :string]]
[:before-path [:maybe [:vector :string]]]
[:before-group? [:maybe :boolean]]]]
[:before-group [:maybe :boolean]]]]
[:move-token-set-group-before
[:map {:title "MoveTokenSetGroupBefore"}
@ -1051,11 +1051,11 @@
(ctob/ensure-tokens-lib)
(ctob/rename-set-group set-group-path set-group-fname)))))
(defmethod process-change :move-token-set-before
[data {:keys [from-path to-path before-path before-group?] :as changes}]
(defmethod process-change :move-token-set
[data {:keys [from-path to-path before-path before-group] :as changes}]
(update data :tokens-lib #(-> %
(ctob/ensure-tokens-lib)
(ctob/move-set from-path to-path before-path before-group?))))
(ctob/move-set from-path to-path before-path before-group))))
(defmethod process-change :move-token-set-group-before
[data {:keys [from-path to-path before-path before-group?]}]

View file

@ -809,19 +809,19 @@
(update :undo-changes conj {:type :rename-token-set-group :set-group-path undo-path :set-group-fname undo-fname})
(apply-changes-local))))
(defn move-token-set-before
(defn move-token-set
[changes {:keys [from-path to-path before-path before-group? prev-before-path prev-before-group?] :as opts}]
(-> changes
(update :redo-changes conj {:type :move-token-set-before
(update :redo-changes conj {:type :move-token-set
:from-path from-path
:to-path to-path
:before-path before-path
:before-group? before-group?})
(update :undo-changes conj {:type :move-token-set-before
:before-group before-group?})
(update :undo-changes conj {:type :move-token-set
:from-path to-path
:to-path from-path
:before-path prev-before-path
:before-group? prev-before-group?})
:before-group prev-before-group?})
(apply-changes-local)))
(defn move-token-set-group-before

View file

@ -29,7 +29,6 @@
[app.common.types.file :as ctf]
[app.common.types.shape :as cts]
[app.common.types.shape.shadow :as ctss]
[app.common.types.tokens-lib :as ctob]
[app.common.uuid :as uuid]
[clojure.set :as set]
[cuerdas.core :as str]))
@ -97,13 +96,13 @@
(if (nil? migrations)
(generate-migrations-from-version version)
migrations)))
(migrate)
(update :features (fnil into #{}) (deref cfeat/*new*))
;; NOTE: in some future we can consider to apply
;; a migration to the whole database and remove
;; this code from this function that executes on
;; each file migration operation
(update :features cfeat/migrate-legacy-features)))))
(update :features cfeat/migrate-legacy-features)
(migrate)))))
(defn migrated?
[file]
@ -1226,32 +1225,7 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate-data "Ensure hidden theme"
[data _]
(letfn [(update-tokens-lib [tokens-lib]
(let [hidden-theme (ctob/get-hidden-theme tokens-lib)]
(if (nil? hidden-theme)
(ctob/add-theme tokens-lib (ctob/make-hidden-token-theme))
tokens-lib)))]
(if (contains? data :tokens-lib)
(update data :tokens-lib update-tokens-lib)
data)))
(defmethod migrate-data "Add token theme id"
[data _]
(letfn [(update-tokens-lib [tokens-lib]
(let [themes (ctob/get-themes tokens-lib)]
(reduce (fn [lib theme]
(if (:id theme)
lib
(ctob/update-theme lib (:group theme) (:name theme) #(assoc % :id (str (uuid/next))))))
tokens-lib
themes)))]
(if (contains? data :tokens-lib)
(update data :tokens-lib update-tokens-lib)
data)))
(defmethod migrate-data "Remove tokens from groups"
(defmethod migrate-data "0001-remove-tokens-from-groups"
[data _]
(letfn [(update-object [object]
(cond-> object
@ -1320,6 +1294,4 @@
"legacy-65"
"legacy-66"
"legacy-67"
"Ensure hidden theme"
"Add token theme id"
"Remove tokens from groups"]))
"0001-remove-tokens-from-groups"]))

View file

@ -1,11 +1,21 @@
;; 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.logic.tokens
(:require
[app.common.files.changes-builder :as pcb]
[app.common.types.tokens-lib :as ctob]))
(defn generate-update-active-sets
"Copy the active sets from the currently active themes and move them to the hidden token theme and update the theme with `update-theme-fn`.
Use this for managing sets active state without having to modify a user created theme (\"no themes selected\" state in the ui)."
"Copy the active sets from the currently active themes and move them
to the hidden token theme and update the theme with
`update-theme-fn`.
Use this for managing sets active state without having to modify a
user created theme (\"no themes selected\" state in the ui)."
[changes tokens-lib update-theme-fn]
(let [prev-active-token-themes (ctob/get-active-theme-paths tokens-lib)
active-token-set-names (ctob/get-active-themes-set-names tokens-lib)
@ -21,7 +31,8 @@
hidden-token-theme))))
(defn generate-toggle-token-set
"Toggle a token set at `set-name` in `tokens-lib` without modifying a user theme."
"Toggle a token set at `set-name` in `tokens-lib` without modifying a
user theme."
[changes tokens-lib set-name]
(generate-update-active-sets changes tokens-lib #(ctob/toggle-set % set-name)))
@ -49,12 +60,20 @@
:or {collapsed-paths #{}}}]
(let [tree (-> (ctob/get-set-tree tokens-lib)
(ctob/walk-sets-tree-seq :skip-children-pred #(contains? collapsed-paths %)))
from (nth tree from-index)
to (nth tree to-index)
before (case position
:top to
:bot (nth tree (inc to-index) nil)
:bot (let [v (nth tree (inc to-index) nil)]
;; if the next index is a group, we need to set it as
;; nil because if we set a path on different subpath,
;; the move algorightm will simply remove the set
(if (:group? v)
nil
v))
:center nil)
prev-before (if (:group? from)
(->> (drop (inc from-index) tree)
(filter (fn [element]
@ -113,9 +132,9 @@
(defn generate-move-token-set
"Create changes for dropping a token set or token set.
Throws for impossible moves."
[changes tokens-lib drop-opts]
(if-let [drop-opts' (calculate-move-token-set-or-set-group tokens-lib drop-opts)]
(pcb/move-token-set-before changes drop-opts')
[changes tokens-lib params]
(if-let [params (calculate-move-token-set-or-set-group tokens-lib params)]
(pcb/move-token-set changes params)
changes))
(defn generate-move-token-set-group

View file

@ -588,7 +588,7 @@
(update :group d/nilv top-level-theme-group-name)
(update :description d/nilv "")
(update :is-source d/nilv false)
(update :id d/nilv (str (uuid/next)))
(update :id #(or % (str (uuid/next))))
(update :modified-at #(or % (dt/now)))
(update :sets set)
(check-token-theme-attrs)
@ -612,7 +612,6 @@
(get-theme-tree [_] "get a nested tree of all themes in the library")
(get-themes [_] "get an ordered sequence of all themes in the library")
(get-theme [_ group name] "get one theme looking for name")
(get-hidden-theme [_] "get the theme hidden from the user, used for managing active sets without a user created theme.")
(get-theme-groups [_] "get a sequence of group names by order")
(get-active-theme-paths [_] "get the active theme paths")
(get-active-themes [_] "get an ordered sequence of active themes in the library")
@ -946,14 +945,21 @@ Will return a value that matches this schema:
(let [prefixed-from-path (set-full-path->set-prefixed-full-path from-path)
prev-set (get-in sets prefixed-from-path)]
(if (instance? TokenSet prev-set)
(let [prefixed-to-path (set-full-path->set-prefixed-full-path to-path)
prefixed-before-path (when before-path
(if before-group?
(mapv add-set-path-group-prefix before-path)
(set-full-path->set-prefixed-full-path before-path)))
(let [prefixed-to-path
(set-full-path->set-prefixed-full-path to-path)
prefixed-before-path
(when before-path
(if before-group?
(mapv add-set-path-group-prefix before-path)
(set-full-path->set-prefixed-full-path before-path)))
set
(assoc prev-set :name (join-set-path to-path))
reorder?
(= prefixed-from-path prefixed-to-path)
set (assoc prev-set :name (join-set-path to-path))
reorder? (= prefixed-from-path prefixed-to-path)
sets'
(if reorder?
(d/oreorder-before sets
@ -965,6 +971,7 @@ Will return a value that matches this schema:
(d/oassoc-in-before sets prefixed-before-path prefixed-to-path set)
(d/oassoc-in sets prefixed-to-path set))
(d/dissoc-in prefixed-from-path)))]
(TokensLib. sets'
(if reorder?
themes
@ -1130,9 +1137,6 @@ Will return a value that matches this schema:
(get-theme [_ group name]
(dm/get-in themes [group name]))
(get-hidden-theme [this]
(get-theme this hidden-token-theme-group hidden-token-theme-name))
(set-active-themes [_ active-themes]
(TokensLib. sets
themes
@ -1368,6 +1372,10 @@ Will return a value that matches this schema:
(valid-token-themes? themes)
(valid-active-token-themes? active-themes))))
(defn get-hidden-theme
[tokens-lib]
(get-theme tokens-lib hidden-token-theme-group hidden-token-theme-name))
(defn valid-tokens-lib?
[o]
(and (instance? TokensLib o)
@ -1382,27 +1390,32 @@ Will return a value that matches this schema:
(def ^:private check-active-themes
(sm/check-fn schema:active-themes :hint "expected valid active themes"))
(defn- ensure-hidden-theme
"A helper that is responsible to ensure that the hidden theme always
exists on the themes data structure"
[themes]
(update themes hidden-token-theme-group
(fn [data]
(if (contains? data hidden-token-theme-name)
data
(d/oassoc data hidden-token-theme-name (make-hidden-token-theme))))))
;; NOTE: is possible that ordered map is not the most apropriate
;; data structure and maybe we need a specific that allows us an
;; easy way to reorder it, or just store inside Tokens data
;; structure the data and the order separately as we already do
;; with pages and pages-index.
(defn make-tokens-lib
"Create an empty or prepopulated tokens library."
([]
;; NOTE: is possible that ordered map is not the most apropriate
;; data structure and maybe we need a specific that allows us an
;; easy way to reorder it, or just store inside Tokens data
;; structure the data and the order separately as we already do
;; with pages and pages-index.
(make-tokens-lib :sets (d/ordered-map)
:themes (d/ordered-map)
:active-themes #{hidden-token-theme-path}))
([& {:keys [sets themes active-themes]}]
(let [active-themes (d/nilv active-themes #{hidden-token-theme-path})
themes (if (empty? themes)
(update themes hidden-token-theme-group d/oassoc hidden-token-theme-name (make-hidden-token-theme))
themes)]
(TokensLib.
(check-token-sets sets)
(check-token-themes themes)
(check-active-themes active-themes)))))
[& {:keys [sets themes active-themes]}]
(let [sets (or sets (d/ordered-map))
themes (-> (or themes (d/ordered-map))
(ensure-hidden-theme))
active-themes (or active-themes #{hidden-token-theme-path})]
(TokensLib.
(check-token-sets sets)
(check-token-themes themes)
(check-active-themes active-themes))))
(defn ensure-tokens-lib
[tokens-lib]
@ -1445,6 +1458,71 @@ Will return a value that matches this schema:
:wfn #(into {} %)
:rfn #(map->Token %)})
#?(:clj
(defn- read-tokens-lib-v1-0
"Reads the first version of tokens lib, now completly obsolete"
[r]
(let [;; Migrate sets tree without prefix to new format
prev-sets (->> (fres/read-object! r)
(tree-seq d/ordered-map? vals)
(filter (partial instance? TokenSet)))
sets (-> (reduce add-set (make-tokens-lib) prev-sets)
(deref)
(:sets))
_set-groups (fres/read-object! r)
themes (fres/read-object! r)
active-themes (fres/read-object! r)]
(->TokensLib sets themes active-themes))))
#?(:clj
(defn- read-tokens-lib-v1-1
"Reads the tokens lib data structure and ensures that hidden
theme exists and adds missing ID on themes"
[r]
(let [sets (fres/read-object! r)
themes (fres/read-object! r)
active-themes (fres/read-object! r)
;; Ensure we have at least a hidden theme
themes
(ensure-hidden-theme themes)
;; Ensure we add an :id field for each existing theme
themes
(reduce (fn [result group-id]
(update result group-id
(fn [themes]
(reduce (fn [themes theme-id]
(update themes theme-id
(fn [theme]
(if (get theme :id)
theme
(assoc theme :id (str (uuid/next)))))))
themes
(keys themes)))))
themes
(keys themes))]
(->TokensLib sets themes active-themes))))
#?(:clj
(defn- write-tokens-lib
[n w ^TokensLib o]
(fres/write-tag! w n 3)
(fres/write-object! w (.-sets o))
(fres/write-object! w (.-themes o))
(fres/write-object! w (.-active-themes o))))
#?(:clj
(defn- read-tokens-lib
[r]
(let [sets (fres/read-object! r)
themes (fres/read-object! r)
active-themes (fres/read-object! r)]
(->TokensLib sets themes active-themes))))
#?(:clj
(fres/add-handlers!
{:name "penpot/token/v1"
@ -1474,32 +1552,15 @@ Will return a value that matches this schema:
(let [obj (fres/read-object! r)]
(map->TokenTheme obj)))}
;; LEGACY TOKENS LIB READERS (with migrations)
{:name "penpot/tokens-lib/v1"
:rfn (fn [r]
(let [;; Migrate sets tree without prefix to new format
prev-sets (->> (fres/read-object! r)
(tree-seq d/ordered-map? vals)
(filter (partial instance? TokenSet)))
;; FIXME: wtf we usind deref here?
sets (-> (reduce add-set (make-tokens-lib) prev-sets)
(deref)
(:sets))
_set-groups (fres/read-object! r)
themes (fres/read-object! r)
active-themes (fres/read-object! r)]
(->TokensLib sets themes active-themes)))}
:rfn read-tokens-lib-v1-0}
{:name "penpot/tokens-lib/v1.1"
:rfn read-tokens-lib-v1-1}
;; CURRENT TOKENS LIB READER & WRITTER
{:name "penpot/tokens-lib/v1.2"
:class TokensLib
:wfn (fn [n w o]
(fres/write-tag! w n 3)
(fres/write-object! w (.-sets o))
(fres/write-object! w (.-themes o))
(fres/write-object! w (.-active-themes o)))
:rfn (fn [r]
(let [sets (fres/read-object! r)
themes (fres/read-object! r)
active-themes (fres/read-object! r)]
(->TokensLib sets themes active-themes)))}))
:wfn write-tokens-lib
:rfn read-tokens-lib}))

View file

@ -84,52 +84,65 @@
(t/is (thrown-with-msg? #?(:cljs js/Error :clj Exception) #"expected valid params for token-set"
(ctob/make-token-set params)))))
(t/deftest move-token-set
(t/testing "flat"
(let [tokens-lib (-> (ctob/make-tokens-lib)
(ctob/add-set (ctob/make-token-set :name "A"))
(ctob/add-set (ctob/make-token-set :name "B"))
(ctob/add-set (ctob/make-token-set :name "Move")))
move (fn [from-path to-path before-path before-group?]
(->> (ctob/move-set tokens-lib from-path to-path before-path before-group?)
(ctob/get-ordered-set-names)
(into [])))]
(t/testing "move to top"
(t/is (= ["Move" "A" "B"] (move ["Move"] ["Move"] ["A"] false))))
(t/deftest move-token-set-flat
(let [tokens-lib (-> (ctob/make-tokens-lib)
(ctob/add-set (ctob/make-token-set :name "A"))
(ctob/add-set (ctob/make-token-set :name "B"))
(ctob/add-set (ctob/make-token-set :name "Move")))
move (fn [from-path to-path before-path before-group?]
(->> (ctob/move-set tokens-lib from-path to-path before-path before-group?)
(ctob/get-ordered-set-names)
(into [])))]
(t/testing "move to top"
(t/is (= ["Move" "A" "B"] (move ["Move"] ["Move"] ["A"] false))))
(t/testing "move in-between"
(t/is (= ["A" "Move" "B"] (move ["Move"] ["Move"] ["B"] false))))
(t/testing "move in-between"
(t/is (= ["A" "Move" "B"] (move ["Move"] ["Move"] ["B"] false))))
(t/testing "move to bottom"
(t/is (= ["A" "B" "Move"] (move ["Move"] ["Move"] nil false))))))
(t/testing "move to bottom"
(t/is (= ["A" "B" "Move"] (move ["Move"] ["Move"] nil false))))))
(t/testing "nested"
(let [tokens-lib (-> (ctob/make-tokens-lib)
(ctob/add-set (ctob/make-token-set :name "Foo/Baz"))
(ctob/add-set (ctob/make-token-set :name "Foo/Bar"))
(ctob/add-set (ctob/make-token-set :name "Foo")))
move (fn [from-path to-path before-path before-group?]
(->> (ctob/move-set tokens-lib from-path to-path before-path before-group?)
(ctob/get-ordered-set-names)
(into [])))]
(t/testing "move outside of group"
(t/is (= ["Foo/Baz" "Bar" "Foo"] (move ["Foo" "Bar"] ["Bar"] ["Foo"] false)))
(t/is (= ["Bar" "Foo/Baz" "Foo"] (move ["Foo" "Bar"] ["Bar"] ["Foo" "Baz"] true)))
(t/is (= ["Foo/Baz" "Foo" "Bar"] (move ["Foo" "Bar"] ["Bar"] nil false))))
(t/deftest move-token-set-nested
(let [tokens-lib (-> (ctob/make-tokens-lib)
(ctob/add-set (ctob/make-token-set :name "Foo/Baz"))
(ctob/add-set (ctob/make-token-set :name "Foo/Bar"))
(ctob/add-set (ctob/make-token-set :name "Foo")))
move (fn [from-path to-path before-path before-group?]
(->> (ctob/move-set tokens-lib from-path to-path before-path before-group?)
(ctob/get-ordered-set-names)
(into [])))]
(t/testing "move outside of group"
(t/is (= ["Foo/Baz" "Bar" "Foo"] (move ["Foo" "Bar"] ["Bar"] ["Foo"] false)))
(t/is (= ["Bar" "Foo/Baz" "Foo"] (move ["Foo" "Bar"] ["Bar"] ["Foo" "Baz"] true)))
(t/is (= ["Foo/Baz" "Foo" "Bar"] (move ["Foo" "Bar"] ["Bar"] nil false))))
(t/testing "move inside of group"
(t/is (= ["Foo/Foo" "Foo/Baz" "Foo/Bar"] (move ["Foo"] ["Foo" "Foo"] ["Foo" "Baz"] false)))
(t/is (= ["Foo/Baz" "Foo/Bar" "Foo/Foo"] (move ["Foo"] ["Foo" "Foo"] nil false))))))
(t/testing "move inside of group"
(t/is (= ["Foo/Foo" "Foo/Baz" "Foo/Bar"] (move ["Foo"] ["Foo" "Foo"] ["Foo" "Baz"] false)))
(t/is (= ["Foo/Baz" "Foo/Bar" "Foo/Foo"] (move ["Foo"] ["Foo" "Foo"] nil false))))))
;; FIXME
(t/testing "updates theme set names"
(let [tokens-lib (-> (ctob/make-tokens-lib)
(ctob/add-set (ctob/make-token-set :name "Foo/Bar/Baz"))
(ctob/add-set (ctob/make-token-set :name "Other"))
(ctob/add-theme (ctob/make-token-theme :name "Theme"
:sets #{"Foo/Bar/Baz"}))
(ctob/move-set ["Foo" "Bar" "Baz"] ["Other/Baz"] nil nil))]
(t/is (= #{"Other/Baz"} (:sets (ctob/get-theme tokens-lib "" "Theme")))))))
(t/deftest move-token-set-nested-2
(let [tokens-lib (-> (ctob/make-tokens-lib)
(ctob/add-set (ctob/make-token-set :name "a/b"))
(ctob/add-set (ctob/make-token-set :name "a/a"))
(ctob/add-set (ctob/make-token-set :name "b/a"))
(ctob/add-set (ctob/make-token-set :name "b/b")))
move (fn [from-path to-path before-path before-group?]
(->> (ctob/move-set tokens-lib from-path to-path before-path before-group?)
(ctob/get-ordered-set-names)
(vec)))]
(t/testing "move within group"
(t/is (= ["a/b" "a/a" "b/a" "b/b"] (vec (ctob/get-ordered-set-names tokens-lib))))
(t/is (= ["a/a" "a/b" "b/a" "b/b"] (move ["a" "b"] ["a" "b"] nil true))))))
(t/deftest move-token-set-nested-3
(let [tokens-lib (-> (ctob/make-tokens-lib)
(ctob/add-set (ctob/make-token-set :name "Foo/Bar/Baz"))
(ctob/add-set (ctob/make-token-set :name "Other"))
(ctob/add-theme (ctob/make-token-theme :name "Theme"
:sets #{"Foo/Bar/Baz"}))
(ctob/move-set ["Foo" "Bar" "Baz"] ["Other/Baz"] nil nil))]
(t/is (= #{"Other/Baz"} (:sets (ctob/get-theme tokens-lib "" "Theme"))))))
(t/deftest move-token-set-group
(t/testing "reordering"
@ -213,7 +226,7 @@
(t/is (= (ctob/set-count tokens-lib) 0))))
(t/deftest make-invalid-tokens-lib
(let [params {:sets nil :themes nil}]
(let [params {:sets {} :themes {}}]
(t/is (thrown-with-msg? #?(:cljs js/Error :clj Exception) #"expected valid token sets"
(ctob/make-tokens-lib params)))))

View file

@ -252,6 +252,8 @@
:level :error
:timeout 9000})))))))
;; FIXME: add schema for params
(defn drop-token-set-group [drop-opts]
(ptk/reify ::drop-token-set-group
ptk/WatchEvent
@ -265,17 +267,21 @@
(rx/of
(drop-error (ex-data e))))))))
(defn drop-token-set [drop-opts]
;; FIXME: add schema for params
(defn drop-token-set
[params]
(ptk/reify ::drop-token-set
ptk/WatchEvent
(watch [it state _]
(try
(when-let [changes (clt/generate-move-token-set (pcb/empty-changes it) (get-tokens-lib state) drop-opts)]
(let [tokens-lib (get-tokens-lib state)
changes (-> (pcb/empty-changes it)
(clt/generate-move-token-set tokens-lib params))]
(rx/of (dch/commit-changes changes)
(wtu/update-workspace-tokens)))
(catch :default e
(rx/of
(drop-error (ex-data e))))))))
(catch :default cause
(rx/of (drop-error (ex-data cause))))))))
(defn- create-token-with-set
"A special case when a first token is created and no set exists"

View file

@ -368,13 +368,13 @@
(mf/use-fn
(mf/deps collapsed-paths)
(fn [tree-index position data]
(let [props {:from-index (:index data)
:to-index tree-index
:position position
:collapsed-paths collapsed-paths}]
(let [params {:from-index (:index data)
:to-index tree-index
:position position
:collapsed-paths collapsed-paths}]
(if (:is-group data)
(st/emit! (dt/drop-token-set-group props))
(st/emit! (dt/drop-token-set props))))))
(st/emit! (dt/drop-token-set-group params))
(st/emit! (dt/drop-token-set params))))))
on-toggle-collapse
(mf/use-fn