add before-index and index-nav navigators

This commit is contained in:
nathanmarz 2017-07-24 10:29:11 -04:00
parent 179b705211
commit b7c62e444c
2 changed files with 84 additions and 0 deletions

View file

@ -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

View file

@ -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)