rightmost (clj)

(ns clojure.test-clojure.clojure-zip
  (:use clojure.test)
  (:require [clojure.zip :as zip]))


; zipper
;
; seq-zip
; vector-zip
; xml-zip
;
; node
; branch?
; children
; make-node
; path
; lefts
; rights
; down
; up
; root
; right
; rightmost
; left
; leftmost
;
; insert-left
; insert-right
; replace
; edit
; insert-child
; append-child
; next
; prev
; end?
; remove

(ns babashka.impl.clojure.zip
  {:no-doc true}
  (:require [clojure.zip :as zip]
            [sci.core :as sci :refer [copy-var]]))

(def zip-namespace
  {'zipper       (copy-var zip/zipper zip-ns)
   'seq-zip      (copy-var zip/seq-zip zip-ns)
   'vector-zip   (copy-var zip/vector-zip zip-ns)
   'xml-zip      (copy-var zip/xml-zip zip-ns)
   'node         (copy-var zip/node zip-ns)
   'branch?      (copy-var zip/branch? zip-ns)
   'children     (copy-var zip/children zip-ns)
   'make-node    (copy-var zip/make-node zip-ns)
   'path         (copy-var zip/path zip-ns)
   'lefts        (copy-var zip/lefts zip-ns)
   'rights       (copy-var zip/rights zip-ns)
   'down         (copy-var zip/down zip-ns)
   'up           (copy-var zip/up zip-ns)
   'root         (copy-var zip/root zip-ns)
   'right        (copy-var zip/right zip-ns)
   'rightmost    (copy-var zip/rightmost zip-ns)
   'left         (copy-var zip/left zip-ns)
   'leftmost     (copy-var zip/leftmost zip-ns)
   'insert-left  (copy-var zip/insert-left zip-ns)
   'insert-right (copy-var zip/insert-right zip-ns)
   'replace      (copy-var zip/replace zip-ns)
   'edit         (copy-var zip/edit zip-ns)
   'insert-child (copy-var zip/insert-child zip-ns)
   'append-child (copy-var zip/append-child zip-ns)
   'next         (copy-var zip/next zip-ns)
   'prev         (copy-var zip/prev zip-ns)
   'end?         (copy-var zip/end? zip-ns)
   'remove       (copy-var zip/remove zip-ns)})

(ns pez-rewrite-clj.zip
  "Client facing facade for zipper functions"
  (:refer-clojure :exclude [next find replace remove
                            seq? map? vector? list? set?
                            print map get assoc])
  (:require [pez-rewrite-clj.zip.base :as base]
            [pez-rewrite-clj.parser :as p]
            [pez-rewrite-clj.zip.move :as m]
            [pez-rewrite-clj.zip.findz :as f]
            [pez-rewrite-clj.zip.editz :as ed]
            [pez-rewrite-clj.zip.insert :as ins]
            [pez-rewrite-clj.zip.removez :as rm]
            [pez-rewrite-clj.zip.seqz :as sz]
            [clojure.zip :as z]))


;; **********************************
;; Originally in pez-rewrite-clj.zip.move
;; **********************************
(def right
  "See [[move/right]]"
  m/right)
(def left
  "See [[move/left]]"
  m/left)
(def down
  "See [[move/down]]"
  m/down)
(def up
  "See [[move/up]]"
  m/up)
(def next
  "See [[move/next]]"
  m/next)
(def end?
  "See [[move/end?]]"
  m/end?)
(def rightmost?
  "See [[move/rightmost?]]"
  m/rightmost?)
(def leftmost?
  "See [[move/leftmost?]]"
  m/leftmost?)
(def prev
  "See [[move/prev]]"
  m/prev)
(def leftmost
  "See [[move/leftmost]]"
  m/leftmost)
(def rightmost
  "See [[move/rightmost]]"
  m/rightmost)

(deftest zipper-test
  (is-tc-e seq [(t/Seqable t/Any) :-> (t/U nil (t/Seq t/Any))])
  (is-tc-e #(zipper vector? seq (fn [_ c] c) "abc")
           [-> (t/Vec t/Any)]
           :requires [[clojure.zip :refer [zipper]]])
  (is-tc-err #(zipper vector? seq (fn [c] c) "abc")
             :requires [[clojure.zip :refer [zipper]]]))

(deftest rightmost-test
  (is-tc-e #(rightmost [1 2 3]) 
           [-> (t/Vec t/Any)]
           :requires [[clojure.zip :refer [rightmost]]])
  (is-tc-err #(rightmost [1 2 3]) 
             [-> t/Str]
             :requires [[clojure.zip :refer [rightmost]]])
  (is-tc-err #(rightmost 1)
             :requires [[clojure.zip :refer [rightmost]]]))

(require '[clojure.zip :as zip])

(def skip-to-rightmost-leaf
     (fn [zipper]
       (let [over (zip/rightmost zipper)]
         (if (or (not (zip/branch? over))
                 (empty? (zip/children over)))
           over
           (-> over
               zip/down
               skip-to-rightmost-leaf)))))

                              (above? zipper 'quote)
                              ;; The following could be written like this:
                              ;; (if (nil? (zip/right zipper))
                              ;;   zipper
                              ;;   (-> zipper zip/right do-node))
                              ;; ... instead of using `skip-to-rightmost-leaf`. 
                              ;; I prefer the consistency of having all the `cond`
                              ;; clauses use `advancing`. 
                              ;; In any case, in the real Midje code,
                              ;; skip-to-rightmost-leaf is used in other
                              ;; places.
                              (advancing (fn [] (-> zipper zip/down skip-to-rightmost-leaf)))
                              
                              (at? zipper '=>)
                              (advancing 
                               (fn []
                                 (let [replacement (list 'expect
                                                         (-> zipper zip/left zip/node)
                                                         (-> zipper zip/node)
                                                         (-> zipper zip/right zip/node))]
                                   (-> zipper
                                       zip/left
                                       (zip/replace replacement)
                                       zip/right
                                       zip/remove
                                       zip/next
                                       zip/remove))))
                              :else
                              (advancing (constantly zipper))))]
         (-> form zip/seq-zip do-node zip/root))))

                              (above? zipper 'quote)
                              (advancing (fn [] (-> zipper zip/down skip-to-rightmost-leaf)))
                              
                              (above? zipper 'provided)
                              (advancing
                               (fn []
                                 (let [function-call-z (-> zipper zip/down zip/right)
                                       arrow-z (-> function-call-z zip/right)
                                       return-value-z (-> arrow-z zip/right)
                                       addition (list 'fake
                                                      (zip/node function-call-z)
                                                      (zip/node arrow-z)
                                                      (zip/node return-value-z))]
                                   (-> zipper
                                       zip/left
                                       (zip/append-child addition)
                                       zip/right
                                       zip/remove))))
                              
                              (at? zipper '=>)
                              (advancing 
                               (fn []
                                 (let [replacement (list 'expect
                                                         (-> zipper zip/left zip/node)
                                                         (-> zipper zip/node)
                                                         (-> zipper zip/right zip/node))]
                                   (-> zipper
                                       zip/left
                                       (zip/replace replacement)
                                       zip/right
                                       zip/remove
                                       zip/next
                                       zip/remove))))
                              :else
                              (advancing (constantly zipper))))]
         (-> form zip/seq-zip do-node zip/root))))

[ns clojure.test-clojure.clojure-zip
  [:use clojure.test]
  [:require (clojure.zip :as zip)]]


; zipper
;
; seq-zip
; vector-zip
; xml-zip
;
; node
; branch?
; children
; make-node
; path
; lefts
; rights
; down
; up
; root
; right
; rightmost
; left
; leftmost
;
; insert-left
; insert-right
; replace
; edit
; insert-child
; append-child
; next
; prev
; end?
; remove