fix zipper navigation to stop navigating when right/left/up/down/next navigate nowhere

This commit is contained in:
Nathan Marz 2016-04-24 13:03:29 -04:00
parent 64700208f6
commit 96d5e94a5b
3 changed files with 64 additions and 7 deletions

View file

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

View file

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

View file

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