babashka/test-resources/lib_tests/rewrite_clj/zip_test.cljc

(ns rewrite-clj.zip-test
  "This test namespace originated from rewrite-cljs."
  (:require [clojure.string :as string]
            [clojure.test :refer [deftest testing is are]]
            [rewrite-clj.node :as n]
            [rewrite-clj.zip :as z]))

(deftest of-string-simple-sexpr
  (let [sexpr "(+ 1 2)"]
    (is (= sexpr (-> sexpr z/of-string z/root-string)))))

(deftest manipulate-sexpr
  (let [sexpr
        (string/join
         "\n" [""
               " ^{:dynamic true} (+ 1 1"
               "   (+ 2 2)"
               "   (reduce + [1 3 4]))"])
        expected
        (string/join
         "\n" [""
               " ^{:dynamic true} (+ 1 1"
               "   (+ 2 2)"
               "   (reduce + [6 7 [1 2]]))"])]
    (is (= expected (-> (z/of-string sexpr {:track-position? true})
                        (z/find-tag-by-pos {:row 4 :col 19} :vector) ;; should find [1 3 4] col 19 points to element 4 in vector
                        (z/replace [5 6 7])                          ;; replaces [1 3 4] with [5 6 7]
                        (z/append-child [1 2])                       ;; appends [1 2] to [5 6 7] giving [5 6 [1 2]]
                        z/down                                       ;; navigate to 5
                        z/remove                                     ;; remove 5 giving [6 7 [1 2]]
                        z/root-string)))))

(deftest t-rowcolumn-positions-from-position-tracking-zipper
  ;; if you update this test, please also review/update:
  ;;   rewrite-clj.parser-test.t-rowcolumn-metadata-from-clojure-tools-reader
  (let [s (str
           ;12345678901234
           "(defn f\n"
           "  [x]\n"
           "  (println x))")
        positions (->> (z/of-string s {:track-position? true})
                       (iterate z/next)
                       (take-while #(not (z/end? %)))
                       (reduce (fn [acc zloc]
                                 (let [[start end] (z/position-span zloc)]
                                   (assoc acc start {:node (z/node zloc) :end-pos end})))
                               {}))]
    (are [?pos ?end ?t ?s ?sexpr]
         (let [{:keys [node end-pos]} (positions ?pos)]
           (is (= ?t (n/tag node)))
           (is (= ?s (n/string node)))
           (is (= ?sexpr (n/sexpr node)))
           (is (= ?end end-pos)))
      [1 1]  [3 15] :list   s              '(defn f [x] (println x))
      [1 2]  [1 6]  :token  "defn"         'defn
      [1 7]  [1 8]  :token  "f"            'f
      [2 3]  [2 6]  :vector "[x]"          '[x]
      [2 4]  [2 5]  :token  "x"            'x
      [3 3]  [3 14] :list   "(println x)"  '(println x)
      [3 4]  [3 11] :token  "println"      'println
      [3 12] [3 13] :token  "x"            'x)))

(deftest namespaced-keywords
  (is (= ":dill" (-> ":dill" z/of-string z/root-string)))
  (is (= "::dill" (-> "::dill" z/of-string z/root-string)))
  (is (= ":dill/dall" (-> ":dill/dall" z/of-string z/root-string)))
  (is (= "::dill/dall" (-> "::dill/dall" z/of-string z/root-string)))
  (is (= ":%dill.*" (-> ":%dill.*" z/of-string z/root-string))))


(deftest sexpr-udpates-correctly-for-namespaced-map-keys
  (testing "on parse"
    (is (= '(:prefix/a 1 :prefix/b 2 prefix/c 3)
           (-> "#:prefix {:a 1 :b 2 c 3}"
               z/of-string
               z/down
               z/rightmost
               z/child-sexprs))))
  (testing "on insert new key val"
    (is (= '(:prefix/a 1 :prefix/b 2 prefix/c 3 prefix/d 4)
           (-> "#:prefix {:a 1 :b 2 c 3}"
               z/of-string
               z/down
               z/rightmost
               (z/append-child 'd)
               (z/append-child 4)
               z/up ;; changes and also nsmap context are applied when moving up to nsmap
               z/down
               z/rightmost
               z/child-sexprs))))
  (testing "on update existing key val"
    (is (= '(:prefix/a 1 :prefix/b2 2 prefix/c 3)
           (-> "#:prefix {:a 1 :b 2 c 3}"
               z/of-string
               z/down
               z/rightmost
               z/down
               z/right
               z/right
               (z/replace :b2)
               z/up ;; changes and also nsmap context are applied when moving up to nsmap
               z/up
               z/down
               z/rightmost
               z/child-sexprs))))
  (testing "on update creating unbalanced map (which rewrite-clj allows) context is cleared/applied as appropriate"
    (is (= '(:prefix/hi :a prefix/b :c prefix/d e prefix/f)
           (-> "#:prefix {:a b :c d e f}"
               z/of-string
               z/down
               z/rightmost
               (z/insert-child :hi)
               z/up ;; changes and also nsmap context are applied when moving up to nsmap
               z/down
               z/rightmost
               z/child-sexprs))))
  (testing "namespaced map qualifier can be changed and affect sexpr of its map keys"
    (is (= '(:??_ns-alias_??/a 1 :??_ns-alias_??/b 2 :c 3)
           (-> "#:prefix {:a 1 :b 2 :_/c 3}"
               z/of-string
               z/down
               (z/replace (n/map-qualifier-node true "ns-alias"))
               z/up
               z/down
               z/rightmost
               z/child-sexprs))))
  (testing "node context can be be explicitly removed when moving node out of namespaced map"
    (is (= '[{:prefix/b 2 :prefix/c 3}
             {:a 1 :z 99}]
           (let [zloc (-> "[#:prefix {:a 1 :b 2 :c 3}{:z 99}]"
                          z/of-string
                          z/down
                          z/down
                          z/rightmost
                          z/down)
                 move-me1 (-> zloc z/node n/map-context-clear) ;; if we don't clear the map context it will remain
                 zloc (-> zloc z/remove z/down)
                 move-me2 (-> zloc z/node)
                 zloc (z/remove zloc)]
             (-> zloc
                 z/up
                 z/right
                 (z/insert-child move-me2)
                 (z/insert-child move-me1)
                 z/up
                 z/sexpr)))))
  (testing "node context can be explicitly reapplied to entire zloc downward"
    (is (= '[{:prefix/b 2 :prefix/c 3}
             {:a 1 :z 99}]
           (let [zloc (-> "[#:prefix {:a 1 :b 2 :c 3}{:z 99}]"
                          z/of-string
                          z/down
                          z/down
                          z/rightmost
                          z/down)
                 move-me1 (-> zloc z/node)  ;; notice we don't clear context here
                 zloc (-> zloc z/remove z/down)
                 move-me2 (-> zloc z/node)
                 zloc (z/remove zloc)]
             (-> zloc
                 z/up
                 z/right
                 (z/insert-child move-me2)
                 (z/insert-child move-me1)
                 z/up
                 z/reapply-context ;; but we do reapply context to tree before doing a sexpr
                 z/sexpr))))))

(deftest t-sexpr-able
  ;; spot check, more thorough testing done on node tests
  (is (= false (-> "," z/of-string z/next* z/sexpr-able?)))
  (is (= true (-> "heyy" z/of-string z/sexpr-able?))))