diff --git a/common/src/app/common/path_names.cljc b/common/src/app/common/path_names.cljc index de96093155..cc1526eae0 100644 --- a/common/src/app/common/path_names.cljc +++ b/common/src/app/common/path_names.cljc @@ -118,7 +118,10 @@ Some naming conventions: [path] (last (split-path path))) -(defn inside-path? [child parent] +(defn inside-path? + "Returns true when `child` equals `parent` or is nested inside it, + comparing both as path segments (e.g. 'a / b / c' is inside 'a / b')." + [child parent] (let [child-path (split-path child) parent-path (split-path parent)] (and (<= (count parent-path) (count child-path)) @@ -135,90 +138,94 @@ Some naming conventions: ;; Tree building functions -------------------------------------------------- -"Build tree structure from flat list of paths" - -"`build-tree-root` is the main function to build the tree." - -"Receives a list of segments with 'name' properties representing paths, - and a separator string." -"E.g segments = [{... :name 'one/two/three'} {... :name 'one/two/four'} {... :name 'one/five'}]" - -"Transforms into a tree structure like: - [{:name 'one' - :path 'one' - :depth 0 - :leaf nil - :children [{:name 'two' - :path 'one.two' - :depth 1 - :leaf nil - :children [{... :name 'three'} {... :name 'four'}]} - {:name 'five' - :path 'one.five' - :depth 1 - :leaf {... :name 'five'} - :children nil}]}]" - -(defn- sort-by-children - "Sorts segments so that those with children come first." - [segments separator] - (sort-by (fn [segment] - (let [path (split-path (:name segment) :separator separator) - path-length (count path)] - (if (= path-length 1) - 1 - 0))) - segments)) +(defn- attach-remaining-path + "Annotates a segment with ::remaining-path: the vector of path segments + still to descend after the current level. Computed once, at the root, + from the segment :name." + [segment separator] + (assoc segment ::remaining-path (split-path (:name segment) :separator separator))) (defn- group-by-first-segment - "Groups segments by their first path segment and update segment name." - [segments separator] + "Groups segments by the first element of their ::remaining-path and + advances that path by one element. + + A segment whose ::remaining-path becomes empty is a token that ends at + the current node; a non-empty one still has descendants below it." + [segments] (reduce (fn [acc segment] - (let [[first-segment & remaining-segments] (split-path (:name segment) :separator separator) - rest-path (when (seq remaining-segments) (join-path remaining-segments :separator separator :with-spaces? false))] - (update acc first-segment (fnil conj []) - (if rest-path - (assoc segment :name rest-path) - segment)))) + (let [path (::remaining-path segment)] + (update acc (first path) (fnil conj []) + (update segment ::remaining-path subvec 1)))) {} segments)) (defn- sort-and-group-segments - "Sorts elements and groups them by their first path segment." - [segments separator] - (let [sorted (sort-by-children segments separator) - grouped (group-by-first-segment sorted separator)] - (into (sorted-map) grouped))) + "Groups elements by their first path segment, keyed in sorted order." + [segments] + (into (sorted-map) (group-by-first-segment segments))) (defn- build-tree-node "Builds a single tree node with computed children." - [segment-name remaining-segments separator parent-path depth] + [segment-name remaining-segments parent-path depth] (let [current-path (if parent-path (str parent-path "." segment-name) segment-name) - is-leaf? (and (seq remaining-segments) - (every? (fn [segment] - (let [remaining-segment-name (first (split-path (:name segment) :separator separator))] - (= segment-name remaining-segment-name))) - remaining-segments)) + leaf-segment (some (fn [segment] + (when (empty? (::remaining-path segment)) + (-> segment + (assoc :name segment-name) + (dissoc ::remaining-path)))) + remaining-segments) - leaf-segment (when is-leaf? (first remaining-segments)) - node {:name segment-name - :path current-path - :depth depth - :leaf leaf-segment - :children (when-not is-leaf? - (let [grouped-elements (sort-and-group-segments remaining-segments separator)] - (mapv (fn [[child-segment-name remaining-child-segments]] - (build-tree-node child-segment-name remaining-child-segments separator current-path (inc depth))) - grouped-elements)))}] - node)) + child-segments (filter #(seq (::remaining-path %)) remaining-segments) + + children (when (seq child-segments) + (let [grouped-elements (sort-and-group-segments child-segments)] + (mapv (fn [[child-segment-name remaining-child-segments]] + (build-tree-node child-segment-name remaining-child-segments current-path (inc depth))) + grouped-elements)))] + + {:name segment-name + :path current-path + :depth depth + :leaf leaf-segment + :children children})) + +(defn- attach-remaining-paths + "Annotates every segment with its ::remaining-path vector." + [segments separator] + (map #(attach-remaining-path % separator) segments)) + +(defn- build-root-node + "Builds a root-level tree node from a grouped element." + [[segment-name remaining-segments]] + (build-tree-node segment-name remaining-segments nil 0)) (defn build-tree-root - "Builds the root level of the tree." + "Builds the root level of the tree from a flat list of path segments. + + Receives a list of segments with a :name that represents a path, and + the separator used to split each name, e.g.: + + [{... :name 'one/two/three'} {... :name 'one/two/four'} {... :name 'one/five'}] + + Transforms them into a tree of nodes shaped like: + + [{:name 'one' + :path 'one' + :depth 0 + :leaf nil + :children [{:name 'two' + :path 'one.two' + :depth 1 + :leaf nil + :children [{... :name 'three'} {... :name 'four'}]} + {:name 'five' + :path 'one.five' + :depth 1 + :leaf {... :name 'five'} + :children nil}]}]" [segments separator] - (let [grouped-elements (sort-and-group-segments segments separator)] - (mapv (fn [[segment-name remaining-segments]] - (build-tree-node segment-name remaining-segments separator nil 0)) - grouped-elements))) + (let [grouped-elements (sort-and-group-segments (attach-remaining-paths segments separator))] + (mapv build-root-node grouped-elements))) diff --git a/common/src/app/common/types/tokens_lib.cljc b/common/src/app/common/types/tokens_lib.cljc index a99a9502d2..082da2d43e 100644 --- a/common/src/app/common/types/tokens_lib.cljc +++ b/common/src/app/common/types/tokens_lib.cljc @@ -147,7 +147,9 @@ (check-token-attrs) (map->Token))) -(def ^:private token-separator ".") +(def token-separator + "Separator used to split a token name into its path segments." + ".") (defn get-token-path [token] @@ -167,9 +169,9 @@ (rename-path node nil new-name)) ([node token new-name] (let [element (if token (:name token) (:path node)) - split-path (cpn/split-path element :separator ".") + split-path (cpn/split-path element :separator token-separator) updated-split-element-name (assoc split-path (:depth node) new-name) - new-element-path (cpn/join-path updated-split-element-name :separator "." :with-spaces? false)] + new-element-path (cpn/join-path updated-split-element-name :separator token-separator :with-spaces? false)] new-element-path))) ;; === Token Set diff --git a/common/test/common_tests/path_names_tree_test.cljc b/common/test/common_tests/path_names_tree_test.cljc new file mode 100644 index 0000000000..b39b5fc0b2 --- /dev/null +++ b/common/test/common_tests/path_names_tree_test.cljc @@ -0,0 +1,97 @@ +;; 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 SUBSIDIARY SL + +(ns common-tests.path-names-tree-test + (:require + [app.common.files.tokens :as cfo] + [app.common.path-names :as cpn] + [app.common.types.tokens-lib :as ctob] + [clojure.test :as t])) + +(defn- single-chain-terminal + "Follows the first child down a single-token tree to its terminal node." + [root] + (loop [node root] + (if (:children node) + (recur (first (:children node))) + node))) + +(defn- tree-payloads + "Collects every node and :leaf map in a tree for marker-leak checks." + [node] + (cons node + (concat (when (:leaf node) [(:leaf node)]) + (mapcat tree-payloads (:children node))))) + +(defn- tree-leaves + "Collects every token leaf from a tree." + [nodes] + (mapcat (fn [node] + (concat (when (:leaf node) [(:leaf node)]) + (tree-leaves (:children node)))) + nodes)) + +(t/deftest build-tree-root-preserves-repeated-segments + (t/testing "#11588: adjacent repeated path segments keep their depth" + (let [tree (cpn/build-tree-root [{:name "test.pointer.pointer" :id "t1"}] ".") + terminal (single-chain-terminal (first tree))] + (t/is (= "test" (-> tree first :name))) + (t/is (= "pointer" (-> tree first :children first :name))) + (t/is (nil? (-> tree first :children first :leaf))) + (t/is (= "pointer" (:name terminal))) + (t/is (= "test.pointer.pointer" (:path terminal))) + (t/is (= {:name "pointer" :id "t1"} (:leaf terminal))) + (t/is (nil? (:children terminal))) + (t/is (every? #(not (contains? % :app.common.path-names/remaining-path)) + (tree-payloads (first tree)))))) + (t/testing "control case without repeated segments is unchanged" + (let [tree (cpn/build-tree-root [{:name "test.thing.other-thing" :id "t2"}] ".") + terminal (single-chain-terminal (first tree))] + (t/is (= "test" (-> tree first :name))) + (t/is (= "thing" (-> tree first :children first :name))) + (t/is (= "other-thing" (:name terminal))) + (t/is (= {:name "other-thing" :id "t2"} (:leaf terminal))))) + (t/testing "repeated and non-repeated siblings coexist" + (let [tree (cpn/build-tree-root [{:name "test.pointer.pointer" :id "t1"} + {:name "test.thing.other-thing" :id "t2"}] ".") + children (-> tree first :children)] + (t/is (= ["pointer" "thing"] (mapv :name children))) + (t/is (= {:name "pointer" :id "t1"} (-> children first :children first :leaf))))) + (t/testing "longer repeated runs keep every depth" + (doseq [[path id] [["test.test.pointer" "t3"] ["test.test.test" "t4"] + ["a.a" "t5"] ["a.b.b" "t6"] ["a.a.a" "t8"]]] + (let [segments (cpn/split-path path :separator ".") + root (first (cpn/build-tree-root [{:name path :id id}] ".")) + terminal (single-chain-terminal root)] + (t/is (= (last segments) (:name terminal)) path) + (t/is (= (inc (count segments)) (count (tree-payloads root))) path) + (t/is (= {:name (last segments) :id id} (:leaf terminal)) path))))) + +(t/deftest build-tree-root-preserves-active-set-ancestor-and-descendant + (t/testing "#11588: an ancestor token and its descendant in the active set are both kept" + (let [tokens-lib (ctob/read-multi-set-dtcg + {"Global" {"a.a" {"$value" "#aaa" "$type" "color"} + "a.a.a" {"$value" "#bbb" "$type" "color"}} + "$themes" [] + "$metadata" {"tokenSetOrder" ["Global"] + "activeSets" ["Global"]}}) + tokens-status (cfo/make-tokens-status-from-lib tokens-lib) + active-tokens (cfo/get-tokens-in-active-sets tokens-status tokens-lib) + tree (cpn/build-tree-root (vec (vals active-tokens)) ".") + collision (-> tree first :children first) + leaves (tree-leaves tree)] + (t/is (= #{"a.a" "a.a.a"} (set (keys active-tokens)))) + (t/is (= 2 (count leaves))) + (t/is (= #{(get-in active-tokens ["a.a" :id]) + (get-in active-tokens ["a.a.a" :id])} + (set (map :id leaves)))) + (t/is (= "a.a" (:path collision))) + (t/is (= (get-in active-tokens ["a.a" :id]) + (get-in collision [:leaf :id]))) + (t/is (= (get-in active-tokens ["a.a.a" :id]) + (get-in collision [:children 0 :leaf :id]))) + (t/is (every? #(not (contains? % :app.common.path-names/remaining-path)) + (mapcat tree-payloads tree)))))) diff --git a/common/test/common_tests/runner.cljc b/common/test/common_tests/runner.cljc index 88e10df432..7a4c4243f4 100644 --- a/common/test/common_tests/runner.cljc +++ b/common/test/common_tests/runner.cljc @@ -80,6 +80,7 @@ [common-tests.math-test] [common-tests.media-test] [common-tests.path-names-test] + [common-tests.path-names-tree-test] [common-tests.record-test] [common-tests.schema-test] [common-tests.spec-test] @@ -184,6 +185,7 @@ 'common-tests.math-test 'common-tests.media-test 'common-tests.path-names-test + 'common-tests.path-names-tree-test 'common-tests.record-test 'common-tests.schema-test 'common-tests.spec-test diff --git a/frontend/src/app/main/ui/workspace/tokens/management.cljs b/frontend/src/app/main/ui/workspace/tokens/management.cljs index c50c8e0d58..dbf6e42980 100644 --- a/frontend/src/app/main/ui/workspace/tokens/management.cljs +++ b/frontend/src/app/main/ui/workspace/tokens/management.cljs @@ -26,6 +26,13 @@ [cuerdas.core :as str] [rumext.v2 :as mf])) +(defn token-in-path? + "True when `token-name` is exactly `path` or nested below it. This keeps an + ancestor token inside the operations of its own path-based group." + [path token-name] + (or (= token-name path) + (str/starts-with? token-name (str path ctob/token-separator)))) + (defn- get-sorted-token-groups "Separate token-types into groups of `empty` or `filled` depending if tokens exist for that type. Sort each group alphabetically (by their type)." @@ -130,9 +137,9 @@ (fn [tokens-filtered-by-type node] (->> tokens-filtered-by-type (filter (fn [token] - (let [token-path (cpn/split-path (:name token) :separator ".")] + (let [token-path (cpn/split-path (:name token) :separator ctob/token-separator)] (and (> (count token-path) 0) - (str/starts-with? (:name token) (str (:path node) "."))))))))) + (token-in-path? (:path node) (:name token))))))))) ;; Filter tokens by their path and return their ids filter-tokens-by-path-ids @@ -142,7 +149,8 @@ (->> selected-token-set-tokens (filter (fn [token] (let [[_ token-value] token] - (and (= (:type token-value) type) (str/starts-with? (:name token-value) (str path ".")))))) + (and (= (:type token-value) type) + (token-in-path? path (:name token-value)))))) (mapv (fn [token] (let [[_ token-value] token] (:id token-value))))))) diff --git a/frontend/src/app/main/ui/workspace/tokens/management/token_tree.cljs b/frontend/src/app/main/ui/workspace/tokens/management/token_tree.cljs index 3a5973209a..55bbffd676 100644 --- a/frontend/src/app/main/ui/workspace/tokens/management/token_tree.cljs +++ b/frontend/src/app/main/ui/workspace/tokens/management/token_tree.cljs @@ -31,8 +31,56 @@ [:on-node-context-menu {:optional true} fn?] [:can-edit {:optional true} :boolean]]) +(defn- leaf-node? + "A tree node is a leaf when it holds a token and has no children." + [node] + (and (:leaf node) (not (seq (:children node))))) + +(defn- sort-nodes + "Sorts tree nodes so that leaf tokens come before groups, sorting each + set naturally by name." + [nodes] + (let [[leafs groups] + (reduce (fn [[leafs groups] node] + (if (leaf-node? node) + [(conj leafs node) groups] + [leafs (conj groups node)])) + [[] []] + nodes)] + (concat (d/natural-sort-by :name leafs) + (d/natural-sort-by :name groups)))) + +(def ^:private schema:leaf-node + [:map + [:leaf :any] + [:tokens-lib {:optional true} :any] + [:selected-token-set-id {:optional true} :any] + [:selected-shapes :any] + [:is-selected-inside-layout {:optional true} :boolean] + [:active-theme-tokens {:optional true} :any] + [:can-edit {:optional true} :boolean] + [:on-token-pill-click {:optional true} fn?] + [:on-pill-context-menu {:optional true} fn?]]) + +(mf/defc leaf-node* + {::mf/private true + ::mf/schema schema:leaf-node} + [{:keys [leaf tokens-lib selected-token-set-id selected-shapes + is-selected-inside-layout active-theme-tokens can-edit + on-token-pill-click on-pill-context-menu]}] + (let [id (:id leaf) + token (ctob/get-token tokens-lib selected-token-set-id id)] + [:> token-pill* {:token token + :selected-shapes selected-shapes + :is-selected-inside-layout is-selected-inside-layout + :active-theme-tokens active-theme-tokens + :on-click on-token-pill-click + :can-edit can-edit + :on-context-menu on-pill-context-menu}])) + (mf/defc folder-node* - {::mf/schema schema:folder-node} + {::mf/private true + ::mf/schema schema:folder-node} [{:keys [node type folded-token-paths @@ -47,20 +95,12 @@ can-edit]}] (let [full-path (str (name type) "." (:path node)) is-folder-expanded (not (contains? (set (or folded-token-paths [])) full-path)) + children (:children node) sorted-children (mf/with-memo [children] - (let [[leafs groups] - (reduce (fn [[l g] item] - (if (:leaf item) - [(conj l item) g] - [l (conj g item)])) - [[] []] - children) - sorted-leafs (d/natural-sort-by :name leafs) - sorted-groups (d/natural-sort-by :name groups)] - (concat sorted-leafs sorted-groups))) + (sort-nodes children)) swap-folder-expanded (mf/use-fn @@ -80,40 +120,50 @@ :expanded is-folder-expanded :aria-expanded is-folder-expanded :aria-controls (str "folder-children-" (:path node)) - :is-expandable (not (:leaf node)) + :is-expandable (boolean (seq children)) :on-toggle-expand swap-folder-expanded :on-context-menu node-context-menu-prep}] (when is-folder-expanded [:div {:class (stl/css :folder-children-wrapper) :id (str "folder-children-" (:path node))} - (when (seq children) - (for [child sorted-children] - (if (not (:leaf child)) - [:ul {:class (stl/css :node-parent) - :key (:path child)} - [:> folder-node* {:type type - :node child - :folded-token-paths folded-token-paths - :selected-shapes selected-shapes - :is-selected-inside-layout is-selected-inside-layout - :active-theme-tokens active-theme-tokens - :on-token-pill-click on-token-pill-click - :on-pill-context-menu on-pill-context-menu - :on-node-context-menu on-node-context-menu - :tokens-lib tokens-lib - :can-edit can-edit - :selected-token-set-id selected-token-set-id}]] - (let [id (:id (:leaf child)) - token (ctob/get-token tokens-lib selected-token-set-id id)] - [:> token-pill* - {:key id - :token token - :selected-shapes selected-shapes - :is-selected-inside-layout is-selected-inside-layout - :active-theme-tokens active-theme-tokens - :on-click on-token-pill-click - :can-edit can-edit - :on-context-menu on-pill-context-menu}]))))])])) + (when-let [leaf (:leaf node)] + [:> leaf-node* {:key (:id leaf) + :leaf leaf + :tokens-lib tokens-lib + :selected-token-set-id selected-token-set-id + :selected-shapes selected-shapes + :is-selected-inside-layout is-selected-inside-layout + :active-theme-tokens active-theme-tokens + :can-edit can-edit + :on-token-pill-click on-token-pill-click + :on-pill-context-menu on-pill-context-menu}]) + + (for [child sorted-children] + (if (leaf-node? child) + [:> leaf-node* {:key (:id (:leaf child)) + :leaf (:leaf child) + :tokens-lib tokens-lib + :selected-token-set-id selected-token-set-id + :selected-shapes selected-shapes + :is-selected-inside-layout is-selected-inside-layout + :active-theme-tokens active-theme-tokens + :can-edit can-edit + :on-token-pill-click on-token-pill-click + :on-pill-context-menu on-pill-context-menu}] + [:ul {:class (stl/css :node-parent) + :key (:path child)} + [:> folder-node* {:type type + :node child + :folded-token-paths folded-token-paths + :selected-shapes selected-shapes + :is-selected-inside-layout is-selected-inside-layout + :active-theme-tokens active-theme-tokens + :on-token-pill-click on-token-pill-click + :on-pill-context-menu on-pill-context-menu + :on-node-context-menu on-node-context-menu + :tokens-lib tokens-lib + :can-edit can-edit + :selected-token-set-id selected-token-set-id}]]))])])) (def ^:private schema:token-tree [:map @@ -146,42 +196,35 @@ on-node-context-menu can-edit can-edit-tokens]}] - (let [separator "." - raw-tree + (let [raw-tree (mf/with-memo [tokens] - (cpn/build-tree-root tokens separator)) + (cpn/build-tree-root tokens ctob/token-separator)) - on-node-context-menu (mf/use-fn - (mf/deps can-edit-tokens on-node-context-menu) - (fn [event node] - (when can-edit-tokens - (on-node-context-menu event node)))) + ordered-nodes + (mf/with-memo [raw-tree] + (sort-nodes raw-tree)) + + on-node-context-menu + (mf/use-fn + (mf/deps can-edit-tokens on-node-context-menu) + (fn [event node] + (when can-edit-tokens + (on-node-context-menu event node))))] - ordered-nodes (mf/with-memo [raw-tree] - (let [[leafs groups] - (reduce (fn [[l g] item] - (if (:leaf item) - [(conj l item) g] - [l (conj g item)])) - [[] []] - raw-tree) - sorted-leafs (d/natural-sort-by :name leafs) - sorted-groups (d/natural-sort-by :name groups)] - (concat sorted-leafs sorted-groups)))] [:div {:class (stl/css :token-tree-wrapper)} (for [node ordered-nodes] - (if (:leaf node) - (let [token (ctob/get-token tokens-lib selected-token-set-id (get-in node [:leaf :id]))] - [:> token-pill* - {:token token - :key (:id (:leaf node)) - :selected-shapes selected-shapes - :is-selected-inside-layout is-selected-inside-layout - :active-theme-tokens active-theme-tokens - :on-click on-token-pill-click - :can-edit can-edit - :on-context-menu on-pill-context-menu}]) - ;; Render segment folder + (if (leaf-node? node) + [:> leaf-node* {:key (:id (:leaf node)) + :leaf (:leaf node) + :tokens-lib tokens-lib + :selected-token-set-id selected-token-set-id + :selected-shapes selected-shapes + :is-selected-inside-layout is-selected-inside-layout + :active-theme-tokens active-theme-tokens + :can-edit can-edit + :on-token-pill-click on-token-pill-click + :on-pill-context-menu on-pill-context-menu}] + [:ul {:class (stl/css :node-parent) :key (:path node)} [:> folder-node* {:node node diff --git a/frontend/test/frontend_tests/runner.cljs b/frontend/test/frontend_tests/runner.cljs index 7db391183b..e33ae65f8f 100644 --- a/frontend/test/frontend_tests/runner.cljs +++ b/frontend/test/frontend_tests/runner.cljs @@ -99,6 +99,7 @@ [frontend-tests.tokens.logic.tokens-status-test] [frontend-tests.tokens.style-dictionary-test] [frontend-tests.tokens.token-errors-test] + [frontend-tests.tokens.token-path-test] [frontend-tests.tokens.workspace-tokens-remap-test] [frontend-tests.ui.check-updates-test] [frontend-tests.ui.color-token-position-test] @@ -242,6 +243,7 @@ 'frontend-tests.tokens.logic.token-remapping-test 'frontend-tests.tokens.style-dictionary-test 'frontend-tests.tokens.token-errors-test + 'frontend-tests.tokens.token-path-test 'frontend-tests.tokens.logic.tokens-status-test 'frontend-tests.tokens.workspace-tokens-remap-test 'frontend-tests.ui.check-updates-test diff --git a/frontend/test/frontend_tests/tokens/token_path_test.cljs b/frontend/test/frontend_tests/tokens/token_path_test.cljs new file mode 100644 index 0000000000..06033e0882 --- /dev/null +++ b/frontend/test/frontend_tests/tokens/token_path_test.cljs @@ -0,0 +1,39 @@ +;; 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 SUBSIDIARY SL + +(ns frontend-tests.tokens.token-path-test + (:require + [app.main.ui.workspace.tokens.management :as wtm] + [cljs.test :as t :include-macros true])) + +;; https://github.com/penpot/penpot/issues/11588 +;; A token whose name equals a tree node path must stay in the operations of +;; that node, alongside the tokens nested below it. + +(t/deftest token-in-path-matches-the-path-itself + (t/testing "an ancestor token is in its own path" + (t/is (true? (wtm/token-in-path? "a.a" "a.a"))) + (t/is (true? (wtm/token-in-path? "a" "a"))))) + +(t/deftest token-in-path-matches-nested-tokens + (t/testing "a token nested below the path is in the path" + (t/is (true? (wtm/token-in-path? "a.a" "a.a.a"))) + (t/is (true? (wtm/token-in-path? "a" "a.b.c"))) + (t/is (true? (wtm/token-in-path? "a.a" "a.a.b.c"))))) + +(t/deftest token-in-path-rejects-non-descendants + (t/testing "a sibling is not in the path" + (t/is (false? (wtm/token-in-path? "a.a" "a.b")))) + + (t/testing "a deeper path does not match a shorter token" + (t/is (false? (wtm/token-in-path? "a.a.a" "a.a")))) + + (t/testing "a name sharing the prefix without a separator boundary is not in the path" + (t/is (false? (wtm/token-in-path? "a.a" "a.ab"))) + (t/is (false? (wtm/token-in-path? "a" "ab")))) + + (t/testing "an unrelated path is not in the path" + (t/is (false? (wtm/token-in-path? "x.y" "z")))))