fix zipper navigation to stop navigating when right/left/up/down/next navigate nowhere
This commit is contained in:
parent
64700208f6
commit
96d5e94a5b
3 changed files with 64 additions and 7 deletions
|
|
@ -8,6 +8,7 @@ lein cleantest
|
||||||
|
|
||||||
```
|
```
|
||||||
rm -rf out/
|
rm -rf out/
|
||||||
|
lein cljx
|
||||||
rlwrap java -cp `lein classpath` clojure.main repl.clj
|
rlwrap java -cp `lein classpath` clojure.main repl.clj
|
||||||
(require 'com.rpl.specter.cljs-test-runner)
|
(require 'com.rpl.specter.cljs-test-runner)
|
||||||
```
|
```
|
||||||
|
|
|
||||||
|
|
@ -1,10 +1,10 @@
|
||||||
(ns com.rpl.specter.zipper
|
(ns com.rpl.specter.zipper
|
||||||
#+cljs (:require-macros
|
#+cljs (:require-macros
|
||||||
[com.rpl.specter.macros
|
[com.rpl.specter.macros
|
||||||
:refer [defpath]])
|
:refer [defpath path]])
|
||||||
#+clj
|
#+clj
|
||||||
(:use
|
(:use
|
||||||
[com.rpl.specter.macros :only [defpath]])
|
[com.rpl.specter.macros :only [defpath path]])
|
||||||
(:require [com.rpl.specter :as s]
|
(:require [com.rpl.specter :as s]
|
||||||
[clojure.zip :as zip]))
|
[clojure.zip :as zip]))
|
||||||
|
|
||||||
|
|
@ -19,13 +19,37 @@
|
||||||
(def SEQ-ZIP (zipper zip/seq-zip))
|
(def SEQ-ZIP (zipper zip/seq-zip))
|
||||||
(def XML-ZIP (zipper zip/xml-zip))
|
(def XML-ZIP (zipper zip/xml-zip))
|
||||||
|
|
||||||
(def NEXT (s/view zip/next))
|
|
||||||
(def RIGHT (s/view zip/right))
|
(def NEXT
|
||||||
|
(s/comp-paths
|
||||||
|
(s/view zip/next)
|
||||||
|
(s/if-path zip/end?
|
||||||
|
s/STOP
|
||||||
|
s/STAY)))
|
||||||
|
|
||||||
|
(defn- mk-zip-nav [nav]
|
||||||
|
(path []
|
||||||
|
(select* [this structure next-fn]
|
||||||
|
(let [ret (nav structure)]
|
||||||
|
(if ret (next-fn ret))
|
||||||
|
))
|
||||||
|
(transform* [this structure next-fn]
|
||||||
|
(let [ret (nav structure)]
|
||||||
|
(if ret (next-fn ret) structure)
|
||||||
|
))))
|
||||||
|
|
||||||
|
;; (multi-path RIGHT LEFT) will not navigate to the right and left
|
||||||
|
;; of the currently navigated element because locations aren't stable
|
||||||
|
;; like they are for maps/graphs. The path following RIGHT could
|
||||||
|
;; insert lots of elements all over the sequence, and there's no
|
||||||
|
;; way to determine how to get "back".
|
||||||
|
(def RIGHT (mk-zip-nav zip/right))
|
||||||
|
(def LEFT (mk-zip-nav zip/left))
|
||||||
|
(def DOWN (mk-zip-nav zip/down))
|
||||||
|
(def UP (mk-zip-nav zip/up))
|
||||||
|
|
||||||
(def RIGHTMOST (s/view zip/rightmost))
|
(def RIGHTMOST (s/view zip/rightmost))
|
||||||
(def LEFT (s/view zip/left))
|
|
||||||
(def DOWN (s/view zip/down))
|
|
||||||
(def LEFTMOST (s/view zip/leftmost))
|
(def LEFTMOST (s/view zip/leftmost))
|
||||||
(def UP (s/view zip/up))
|
|
||||||
|
|
||||||
(defn- inner-insert [structure next-fn inserter mover backer]
|
(defn- inner-insert [structure next-fn inserter mover backer]
|
||||||
(let [to-insert (next-fn [])
|
(let [to-insert (next-fn [])
|
||||||
|
|
|
||||||
|
|
@ -3,11 +3,15 @@
|
||||||
[cljs.test :refer [is deftest]]
|
[cljs.test :refer [is deftest]]
|
||||||
[cljs.test.check.cljs-test :refer [defspec]]
|
[cljs.test.check.cljs-test :refer [defspec]]
|
||||||
[com.rpl.specter.cljs-test-helpers :refer [for-all+]]
|
[com.rpl.specter.cljs-test-helpers :refer [for-all+]]
|
||||||
|
[com.rpl.specter.macros
|
||||||
|
:refer [declarepath providepath]]
|
||||||
)
|
)
|
||||||
(:use
|
(:use
|
||||||
#+clj [clojure.test :only [deftest is]]
|
#+clj [clojure.test :only [deftest is]]
|
||||||
#+clj [clojure.test.check.clojure-test :only [defspec]]
|
#+clj [clojure.test.check.clojure-test :only [defspec]]
|
||||||
#+clj [com.rpl.specter.test-helpers :only [for-all+]]
|
#+clj [com.rpl.specter.test-helpers :only [for-all+]]
|
||||||
|
#+clj [com.rpl.specter.macros
|
||||||
|
:only [declarepath providepath]]
|
||||||
)
|
)
|
||||||
(:require #+clj [clojure.test.check.generators :as gen]
|
(:require #+clj [clojure.test.check.generators :as gen]
|
||||||
#+clj [clojure.test.check.properties :as prop]
|
#+clj [clojure.test.check.properties :as prop]
|
||||||
|
|
@ -64,3 +68,31 @@
|
||||||
[1 [2 3 4] 5]
|
[1 [2 3 4] 5]
|
||||||
)))
|
)))
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(declarepath NEXT-WALKER)
|
||||||
|
|
||||||
|
(providepath NEXT-WALKER
|
||||||
|
(s/stay-then-continue
|
||||||
|
z/NEXT
|
||||||
|
NEXT-WALKER
|
||||||
|
))
|
||||||
|
|
||||||
|
|
||||||
|
(deftest next-terminate-test
|
||||||
|
(is (= [2 [3 4 [5]] 6]
|
||||||
|
(s/transform [z/VECTOR-ZIP NEXT-WALKER z/NODE number?]
|
||||||
|
inc
|
||||||
|
[1 [2 3 [4]] 5])))
|
||||||
|
)
|
||||||
|
|
||||||
|
(deftest zipper-nav-stop-test
|
||||||
|
(is (= [1]
|
||||||
|
(s/transform [z/VECTOR-ZIP z/UP z/NODE] inc [1])))
|
||||||
|
(is (= [1]
|
||||||
|
(s/transform [z/VECTOR-ZIP z/DOWN z/LEFT z/NODE] inc [1])))
|
||||||
|
(is (= [1]
|
||||||
|
(s/transform [z/VECTOR-ZIP z/DOWN z/RIGHT z/NODE] inc [1])))
|
||||||
|
(is (= []
|
||||||
|
(s/transform [z/VECTOR-ZIP z/DOWN z/NODE] inc [])))
|
||||||
|
)
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue