diff --git a/src/clj/com/rpl/specter.cljc b/src/clj/com/rpl/specter.cljc index 4b7c92d..26a2956 100644 --- a/src/clj/com/rpl/specter.cljc +++ b/src/clj/com/rpl/specter.cljc @@ -936,6 +936,60 @@ nthpath (eachnav n/nthpath*)) +(defrichnav + ^{:doc "Navigates to the empty space between the index and the prior index. For select + navigates to NONE, and transforms to non-NONE insert at that position."} + before-index + [index] + (select* [this vals structure next-fn] + NONE) + (transform* [this vals structure next-fn] + (let [v (next-fn vals NONE)] + (if (identical? NONE v) + structure + ;; TODO: make a more efficient impl + (setval (srange index index) [v] structure) + )))) + +(defrichnav + ^{:doc "Navigates to the index of the sequence if within 0 and size. Transforms move element + at that index to the new index, shifting other elements in the sequence."} + index-nav + [i] + (select* [this vals structure next-fn] + (if (and (>= i 0) (< i (count structure))) + (next-fn vals i) + NONE + )) + (transform* [this vals structure next-fn] + (if (and (>= i 0) (< i (count structure))) + (let [newi (next-fn vals i)] + (if (= newi i) + structure + (let [v (select-any (nthpath i) structure)] + (if (vector? structure) + (let [shifted (if (< newi i) + (loop [j (dec i) + s structure] + (if (< j newi) + s + (recur (dec j) (assoc s (inc j) (nth s j))) + )) + (loop [j (inc i) + s structure] + (if (> j newi) + s + (recur (inc j) (assoc s (dec j) (nth s j))) + )))] + (assoc shifted newi v) + ) + (->> structure + (setval (nthpath i) NONE) + (setval (before-index newi) v) + ))))) + structure + ))) + (defrichnav ^{:doc "Navigates to result of running `afn` on the currently navigated value."} view diff --git a/test/com/rpl/specter/core_test.cljc b/test/com/rpl/specter/core_test.cljc index 75331d7..d4ccb51 100644 --- a/test/com/rpl/specter/core_test.cljc +++ b/test/com/rpl/specter/core_test.cljc @@ -1587,6 +1587,36 @@ (is (= 2 (binding [*dvar* :b] (dvar-tester)))) ) +(deftest before-index-test + (let [data [1 2 3] + datal '(1 2 3)] + (is (predand= vector? [:a 1 2 3] (setval (s/before-index 0) :a data))) + (is (predand= vector? [1 2 3] (setval (s/before-index 1) s/NONE data))) + (is (predand= vector? [1 :a 2 3] (setval (s/before-index 1) :a data))) + (is (predand= vector? [1 2 3 :a] (setval (s/before-index 3) :a data))) + (is (predand= list? '(:a 1 2 3) (setval (s/before-index 0) :a datal))) + (is (predand= list? '(1 :a 2 3) (setval (s/before-index 1) :a datal))) + (is (predand= list? '(1 2 3 :a) (setval (s/before-index 3) :a datal))) + )) + +(deftest index-nav-test + (let [data [1 2 3 4 5 6] + datal '(1 2 3 4 5 6)] + (is (predand= vector? [3 1 2 4 5 6] (setval (s/index-nav 2) 0 data))) + (is (predand= vector? [1 3 2 4 5 6] (setval (s/index-nav 2) 1 data))) + (is (predand= vector? [1 2 3 4 5 6] (setval (s/index-nav 2) 2 data))) + (is (predand= vector? [1 2 4 5 3 6] (setval (s/index-nav 2) 4 data))) + (is (predand= vector? [1 2 4 5 6 3] (setval (s/index-nav 2) 5 data))) + (is (predand= vector? [6 1 2 3 4 5] (setval (s/index-nav 5) 0 data))) + + (is (predand= list? '(3 1 2 4 5 6) (setval (s/index-nav 2) 0 datal))) + (is (predand= list? '(1 3 2 4 5 6) (setval (s/index-nav 2) 1 datal))) + (is (predand= list? '(1 2 3 4 5 6) (setval (s/index-nav 2) 2 datal))) + (is (predand= list? '(1 2 4 5 3 6) (setval (s/index-nav 2) 4 datal))) + (is (predand= list? '(1 2 4 5 6 3) (setval (s/index-nav 2) 5 datal))) + (is (predand= list? '(6 1 2 3 4 5) (setval (s/index-nav 5) 0 datal))) + )) + #?(:clj (do (defprotocolpath FooPP)