├── .gitignore ├── .gitmodules ├── .travis.yml ├── README.md ├── project.clj ├── src └── jai │ ├── common.clj │ ├── match.clj │ ├── match │ ├── actual.clj │ ├── eval.clj │ ├── fn.clj │ ├── optional.clj │ ├── pattern.clj │ └── regex.clj │ ├── query.clj │ └── query │ ├── compile.clj │ ├── traverse.clj │ └── walk.clj └── test └── jai ├── common_test.clj ├── match ├── fn_test.clj ├── optional_test.clj ├── pattern_test.clj └── set_test.clj ├── match_test.clj ├── query ├── compile_test.clj └── traverse_test.clj ├── query_test.clj └── readme_test.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | .#* 11 | *.*# 12 | /doc -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "docs"] 2 | path = docs 3 | url = https://github.com/zcaudate/jai.git 4 | branch = gh-pages 5 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: clojure 2 | lein: lein2 3 | script: lein2 test 4 | sudo: false -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # jai 2 | 3 | [![Build Status](https://travis-ci.org/zcaudate/jai.png?branch=master)](https://travis-ci.org/zcaudate/jai) 4 | 5 | ### Installation 6 | 7 | Add to project.clj dependencies: 8 | 9 | ```clojure 10 | [im.chit/jai "0.2.12"] 11 | ``` 12 | 13 | All functionality is in the `jai.query` namespace: 14 | 15 | ```clojure 16 | > (use jai.query) 17 | ``` 18 | 19 | Manipulate source code like the DOM 20 | ## Introduction 21 | [jai](https://github.com/zcaudate/jai) makes it easy for querying and manipulation of clojure source code through an xpath/css-inspired syntax. 22 | 23 | - to simplify traversal and manipulation of source code 24 | - to provide higher level abstractions on top of [rewrite-clj](https://github.com/xsc/rewrite-clj) 25 | - to leverage [core.match](https://github.com/clojure/core.match)'s pattern matching 26 | 27 | A [blog post](http://z.caudate.me/manipulate-source-code-like-the-dom/) that tells a little bit more about it. 28 | 29 | ## Motivation 30 | 31 | As lisp code follows a tree-like structure, it is very useful to be able to have a simple language to be able to query as well as update elements of that tree. The best tool for source code manipulation is [rewrite-clj](https://www.github.com/xsc/rewrite-clj). However, it is hard to reason about the higher level concepts of code when using just a zipper for traversal. 32 | 33 | `jai` is essentially a query/manipulation tool inspired by jquery and css selectors that make for easy dom manipulation and query. Instead of writing the following code with `rewrite-clj`: 34 | 35 | ```clojure 36 | (if (and (-> zloc z/prev z/prev z/sexpr (= "defn")) 37 | (-> zloc z/prev z/sexpr vector?) 38 | (do-something zloc) 39 | zloc) 40 | ``` 41 | 42 | `jai` allows the same logic to be written in a much more expressive manner: 43 | 44 | ```clojure 45 | ($ zloc [(defn ^:% vector? | _)] do-something) 46 | ``` 47 | 48 | ### Documentation 49 | 50 | Please see the main [documentation](http://docs.caudate.me/jai) for usage and examples. 51 | 52 | ## License 53 | 54 | Copyright © 2015 Chris Zheng 55 | 56 | Distributed under the MIT License 57 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject im.chit/jai "0.2.12" 2 | :description "Manipulate source code like the DOM" 3 | :url "http://github.com/zcaudate/jai" 4 | :license {:name "The MIT License" 5 | :url "http://opensource.org/licenses/MIT"} 6 | :aliases {"test" ["run" "-m" "hara.test" "exit"]} 7 | :documentation {:files {"docs/index" 8 | {:input "test/jai/readme_test.clj" 9 | :title "jai" 10 | :sub-title "Manipulate source code like the DOM" 11 | :author "Chris Zheng" 12 | :email "z@caudate.me" 13 | :tracking "UA-31320512-2"}}} 14 | :dependencies [[org.clojure/clojure "1.8.0"] 15 | [org.clojure/core.match "0.2.2"] 16 | [rewrite-clj "0.5.1"] 17 | [im.chit/hara.common.checks "2.4.2"]] 18 | :profiles {:dev {:dependencies [[im.chit/hara.test "2.4.2"]] 19 | :plugins [[lein-midje-doc "0.0.24"]]}}) -------------------------------------------------------------------------------- /src/jai/common.clj: -------------------------------------------------------------------------------- 1 | (ns jai.common 2 | (:require [clojure.string :as string] 3 | [clojure.walk :as walk])) 4 | 5 | (defn any 6 | "returns true for any value 7 | (any nil) => true 8 | (any '_) => true" 9 | {:added "0.2"} 10 | [x] true) 11 | 12 | (defn none 13 | "returns false for any value 14 | (none nil) => false 15 | (none '_) => false" 16 | {:added "0.2"} 17 | [x] false) 18 | 19 | (defn expand-meta 20 | "separates out the meta into individual flags 21 | (meta (expand-meta ^:? ())) 22 | => {:? true} 23 | (meta (expand-meta ^:+%? ())) 24 | => {:+ true, :? true, :% true}" 25 | {:added "0.2"} 26 | [ele] 27 | (->> (meta ele) 28 | (keys) 29 | (map name) 30 | (apply str) 31 | (#(string/split % #"")) 32 | (map keyword) 33 | (set) 34 | (#(-> % 35 | (zipmap (repeat true)) 36 | (select-keys [:% :? :& :- :+]))) 37 | (with-meta ele))) 38 | 39 | (defn cursor? 40 | "checks if element is `|` 41 | (cursor? '|) => true 42 | (cursor? '_) => false" 43 | {:added "0.2"} 44 | [ele] (= '| ele)) 45 | 46 | (defn insertion? 47 | "checks if element has an insert meta 48 | (insertion? '^:+ a) => true 49 | (insertion? 'a) => false" 50 | {:added "0.2"} 51 | [ele] (or (-> ele meta :+) false)) 52 | 53 | (defn deletion? 54 | "checks if element has a delete meta 55 | (deletion? '^:- a) => true 56 | (deletion? 'a) => false" 57 | {:added "0.2"} 58 | [ele] (or (-> ele meta :-) false)) 59 | 60 | (defn- wrap-keep-meta [f] 61 | (fn [inner outer form] 62 | (let [obj (f inner outer form)] 63 | (if (and (instance? clojure.lang.IObj form) 64 | (instance? clojure.lang.IObj obj)) 65 | (with-meta obj (meta form)) 66 | obj)))) 67 | 68 | (defn prewalk 69 | [f form] 70 | ((wrap-keep-meta walk/walk) (partial prewalk f) identity (f form))) 71 | 72 | (defn- remove-null [ele] 73 | (cond (list? ele) (with-meta (apply list (filter #(not= ::null %) ele)) 74 | (meta ele)) 75 | (vector? ele) (with-meta (filterv #(not= ::null %) ele) 76 | (meta ele)) 77 | :else ele)) 78 | 79 | (defn- mark-null [pred] 80 | (fn [ele] 81 | (if (pred ele) ::null ele))) 82 | 83 | (defn remove-items 84 | "removes items from a form matching the predicate 85 | (remove-items #(= 1 %) '(1 2 3 4)) 86 | => '(2 3 4) 87 | 88 | (remove-items #(= 1 %) '(1 (1 (1 (1))))) 89 | => '(((())))" 90 | {:added "0.2"} 91 | [pred pattern] 92 | (->> pattern 93 | (prewalk (mark-null pred)) 94 | (prewalk remove-null))) 95 | 96 | (defn prepare-deletion 97 | "removes extraneous symbols for deletion walk 98 | (prepare-deletion '(+ a 2)) 99 | => '(+ a 2) 100 | 101 | (prepare-deletion '(+ ^:+ a | 2)) 102 | => '(+ 2)" 103 | {:added "0.2"} 104 | [pattern] 105 | (->> pattern 106 | (remove-items cursor?) 107 | (remove-items insertion?))) 108 | 109 | (defn prepare-insertion 110 | "removes extraneous symbols for deletion walk 111 | (prepare-insertion '(+ a 2)) 112 | => '(+ a 2) 113 | 114 | (prepare-insertion '(+ ^:+ a | ^:- b 2)) 115 | => '(+ a 2)" 116 | {:added "0.2"} 117 | [pattern] 118 | (->> pattern 119 | (remove-items cursor?) 120 | (remove-items deletion?))) 121 | 122 | (defn prepare-query [pattern] 123 | (->> pattern 124 | (remove-items cursor?) 125 | (remove-items deletion?) 126 | (remove-items insertion?))) 127 | 128 | (defn find-index 129 | "returns the index of the first occurrence 130 | (find-index #(= 2 %) '(1 2 3 4)) 131 | => 1" 132 | {:added "0.2"} 133 | ([pred seq] 134 | (find-index pred seq 0)) 135 | ([pred [x & more :as seq] idx] 136 | (cond (empty? seq) nil 137 | (pred x) idx 138 | :else (recur pred more (inc idx))))) 139 | 140 | (defn finto 141 | "into but the right way for lists 142 | (finto () '(1 2 3)) 143 | => '(1 2 3)" 144 | {:added "0.2"} 145 | [to from] 146 | (cond (list? to) 147 | (into to (reverse from)) 148 | :else (into to from))) 149 | -------------------------------------------------------------------------------- /src/jai/match.clj: -------------------------------------------------------------------------------- 1 | (ns jai.match 2 | (:require [rewrite-clj.zip :as z] 3 | [hara.common.checks :refer [hash-map? regex?]] 4 | [jai.match.pattern :refer [pattern-fn]])) 5 | 6 | (defrecord Matcher [fn] 7 | clojure.lang.IFn 8 | (invoke [this zloc] 9 | (fn zloc))) 10 | 11 | (defn matcher [f] 12 | (Matcher. f)) 13 | 14 | (defn matcher? [x] 15 | (instance? Matcher x)) 16 | 17 | (defn p-fn 18 | "takes a predicate function to check the state of the zipper 19 | ((p-fn (fn [x] 20 | (-> (z/node x) (.tag) (= :token)))) 21 | (z/of-string \"defn\")) 22 | => true" 23 | {:added "0.1"} 24 | [template] 25 | (Matcher. (fn [zloc] 26 | (template zloc)))) 27 | 28 | (defn p-is 29 | "checks if node is equivalent, does not meta into account 30 | ((p-is 'defn) (z/of-string \"defn\")) 31 | => true 32 | 33 | ((p-is '^{:a 1} defn) (z/of-string \"defn\")) 34 | => true 35 | 36 | ((p-is 'defn) (z/of-string \"is\")) 37 | => false 38 | 39 | ((p-is '(defn & _)) (z/of-string \"(defn x [])\")) 40 | => false" 41 | {:added "0.1"} 42 | [template] 43 | (Matcher. (fn [zloc] 44 | (if (fn? template) 45 | (-> zloc z/sexpr template) 46 | (-> zloc z/sexpr (= template)))))) 47 | 48 | (defn p-equal-loop [expr template] 49 | (and (or (= (meta expr) (meta template)) 50 | (and (empty? (meta expr)) (empty? (meta template)))) 51 | (cond (or (list? expr) (vector? expr)) 52 | (and (= (count expr) (count template)) 53 | (every? true? (map p-equal-loop expr template))) 54 | 55 | (set? expr) 56 | (and (= (count expr) (count template)) 57 | (every? true? (map p-equal-loop 58 | (sort expr) 59 | (sort template)))) 60 | 61 | (map? expr) 62 | (and (= (count expr) (count template)) 63 | 64 | (every? true? (map p-equal-loop 65 | (sort (keys expr)) 66 | (sort (keys template)))) 67 | (every? true? (map p-equal-loop 68 | (map #(get expr %) (keys expr)) 69 | (map #(get template %) (keys expr))))) 70 | 71 | :else (= expr template)))) 72 | 73 | (defn p-equal 74 | "checks if the node is equivalent, takes meta into account 75 | ((p-equal '^{:a 1} defn) (z/of-string \"defn\")) 76 | => false 77 | 78 | ((p-equal '^{:a 1} defn) (z/of-string \"^{:a 1} defn\")) 79 | => true 80 | 81 | ((p-equal '^{:a 1} defn) (z/of-string \"^{:a 2} defn\")) 82 | => false" 83 | {:added "0.1"} 84 | [template] 85 | (Matcher. (fn [zloc] 86 | (let [expr (z/sexpr zloc)] 87 | (p-equal-loop expr template))))) 88 | 89 | (defn p-meta 90 | "checks if meta is the same 91 | ((p-meta {:a 1}) (z/down (z/of-string \"^{:a 1} defn\"))) 92 | => true 93 | 94 | ((p-meta {:a 1}) (z/down (z/of-string \"^{:a 2} defn\"))) 95 | => false" 96 | {:added "0.1"} 97 | [template] 98 | (Matcher. (fn [zloc] 99 | (let [mloc (z/up zloc)] 100 | (and (= :meta (z/tag mloc)) 101 | (= (z/sexpr (z/down mloc)) template)))))) 102 | 103 | (defn p-type 104 | "check on the type of element 105 | ((p-type :token) (z/of-string \"defn\")) 106 | => true 107 | 108 | ((p-type :token) (-> (z/of-string \"^{:a 1} defn\") z/down z/right)) 109 | => true" 110 | {:added "0.1"} 111 | [template] 112 | (Matcher. (fn [zloc] 113 | (-> zloc z/tag (= template))))) 114 | 115 | (defn p-form 116 | "checks if it is a form with the symbol as the first element 117 | ((p-form 'defn) (z/of-string \"(defn x [])\")) 118 | => true 119 | ((p-form 'let) (z/of-string \"(let [])\")) 120 | => true" 121 | {:added "0.1"} 122 | [template] 123 | (Matcher. (fn [zloc] 124 | (and (-> zloc z/tag (= :list)) 125 | (-> zloc z/down z/value (= template)))))) 126 | 127 | (defn p-pattern 128 | "checks if the form matches a particular pattern 129 | ((p-pattern '(defn ^:% symbol? & _)) (z/of-string \"(defn ^{:a 1} x [])\")) 130 | => true 131 | 132 | ((p-pattern '(defn ^:% symbol? ^{:% true :? true} string? [])) 133 | (z/of-string \"(defn ^{:a 1} x [])\")) 134 | => true" 135 | {:added "0.1"} 136 | [template] 137 | (Matcher. (fn [zloc] 138 | (let [mf (pattern-fn template)] 139 | (-> zloc z/sexpr mf))))) 140 | 141 | (defn p-code 142 | "checks if the form matches a string in the form of a regex expression 143 | ((p-code #\"defn\") (z/of-string \"(defn ^{:a 1} x [])\")) 144 | => true" 145 | {:added "0.1"} 146 | [template] 147 | (Matcher. (fn [zloc] 148 | (cond (regex? template) 149 | (if (->> zloc z/->string (re-find template)) 150 | true false))))) 151 | 152 | (defn p-and 153 | "takes multiple predicates and ensures that all are correct 154 | ((p-and (p-code #\"defn\") 155 | (p-type :token)) (z/of-string \"(defn ^{:a 1} x [])\")) 156 | => false 157 | 158 | ((p-and (p-code #\"defn\") 159 | (p-type :list)) (z/of-string \"(defn ^{:a 1} x [])\")) 160 | => true" 161 | {:added "0.1"} 162 | [& matchers] 163 | (Matcher. (fn [zloc] 164 | (->> (map (fn [m] (m zloc)) matchers) 165 | (every? true?))))) 166 | 167 | (defn p-or 168 | "takes multiple predicates and ensures that at least one is correct 169 | ((p-or (p-code #\"defn\") 170 | (p-type :token)) (z/of-string \"(defn ^{:a 1} x [])\")) 171 | => true 172 | 173 | ((p-or (p-code #\"defn\") 174 | (p-type :list)) (z/of-string \"(defn ^{:a 1} x [])\")) 175 | => true" 176 | {:added "0.1"} 177 | [& matchers] 178 | (Matcher. (fn [zloc] 179 | (->> (map (fn [m] (m zloc)) matchers) 180 | (some true?))))) 181 | 182 | (declare p-parent p-child p-first p-last p-nth p-nth-left p-nth-right 183 | p-nth-ancestor p-nth-contains p-ancestor p-contains 184 | p-sibling p-left p-right p-right-of p-left-of p-right-most p-left-most) 185 | 186 | (defn compile-matcher [template] 187 | (cond (-> template meta :-) (p-is template) 188 | (-> template meta :%) (compile-matcher {:pattern template}) 189 | (symbol? template) (compile-matcher {:form template}) 190 | (fn? template) (compile-matcher {:is template}) 191 | (list? template) (compile-matcher {:pattern template}) 192 | (regex? template) (compile-matcher {:code template}) 193 | (vector? template) (apply p-and (map compile-matcher template)) 194 | (set? template) (apply p-or (map compile-matcher template)) 195 | (hash-map? template) 196 | (apply p-and 197 | (map (fn [[k v]] 198 | (case k 199 | :fn (p-fn v) 200 | :is (p-is v) 201 | :or (apply p-or (map compile-matcher template)) 202 | :equal (p-equal v) 203 | :type (p-type v) 204 | :meta (p-meta v) 205 | :form (p-form v) 206 | :pattern (p-pattern v) 207 | :code (p-code v) 208 | :parent (p-parent v) 209 | :child (p-child v) 210 | :first (p-first v) 211 | :last (p-last v) 212 | :nth (p-nth v) 213 | :nth-left (p-nth-left v) 214 | :nth-right (p-nth-right v) 215 | :nth-ancestor (p-nth-ancestor v) 216 | :nth-contains (p-nth-contains v) 217 | :ancestor (p-ancestor v) 218 | :contains (p-contains v) 219 | :sibling (p-sibling v) 220 | :left (p-left v) 221 | :right (p-right v) 222 | :left-of (p-left-of v) 223 | :right-of (p-right-of v) 224 | :left-most (p-left-most v) 225 | :right-most (p-right-most v))) 226 | template)) 227 | :else (compile-matcher {:is template}))) 228 | 229 | (defn p-parent 230 | "checks that the parent of the element contains a certain characteristic 231 | ((p-parent 'defn) (-> (z/of-string \"(defn x [])\") z/next z/next)) 232 | => true 233 | 234 | ((p-parent {:parent 'if}) (-> (z/of-string \"(if (= x y))\") z/down z/next z/next)) 235 | => true 236 | 237 | ((p-parent {:parent 'if}) (-> (z/of-string \"(if (= x y))\") z/down)) 238 | => false" 239 | {:added "0.1"} 240 | [template] 241 | (let [template (if (symbol? template) {:form template} template) 242 | m-fn (compile-matcher template)] 243 | (Matcher. (fn [zloc] 244 | (if-let [parent (z/up zloc)] 245 | (and (not= (z/sexpr zloc) 246 | (z/sexpr parent)) 247 | (m-fn parent))))))) 248 | 249 | (defn p-child 250 | "checks that there is a child of a container that has a certain characteristic 251 | ((p-child {:form '=}) (z/of-string \"(if (= x y))\")) 252 | => true 253 | 254 | ((p-child '=) (z/of-string \"(if (= x y))\")) 255 | => false" 256 | {:added "0.1"} 257 | [template] 258 | (let [template (if (symbol? template) {:is template} template) 259 | m-fn (compile-matcher template)] 260 | (Matcher. (fn [zloc] 261 | (if-let [child (z/down zloc)] 262 | (->> child 263 | (iterate z/right) 264 | (take-while identity) 265 | (map m-fn) 266 | (some identity) 267 | nil? not) 268 | false))))) 269 | 270 | (defn p-first 271 | "checks that the first element of the container has a certain characteristic 272 | ((p-first 'defn) (-> (z/of-string \"(defn x [])\"))) 273 | => true 274 | 275 | ((p-first 'x) (-> (z/of-string \"[x y z]\"))) 276 | => true 277 | 278 | ((p-first 'x) (-> (z/of-string \"[y z]\"))) 279 | => false" 280 | {:added "0.1"} 281 | [template] 282 | (let [template (if (symbol? template) {:is template} template) 283 | m-fn (compile-matcher template)] 284 | (Matcher. (fn [zloc] 285 | (if-let [child (z/down zloc)] 286 | (m-fn child)))))) 287 | 288 | (defn p-last 289 | "checks that the last element of the container has a certain characteristic 290 | ((p-last 1) (-> (z/of-string \"(defn [] 1)\"))) 291 | => true 292 | 293 | ((p-last 'z) (-> (z/of-string \"[x y z]\"))) 294 | => true 295 | 296 | ((p-last 'x) (-> (z/of-string \"[y z]\"))) 297 | => false" 298 | {:added "0.1"} 299 | [template] 300 | (let [template (if (symbol? template) {:is template} template) 301 | m-fn (compile-matcher template)] 302 | (Matcher. (fn [zloc] 303 | (if-let [child (-> zloc z/down z/rightmost)] 304 | (m-fn child)))))) 305 | 306 | (defn p-nth 307 | "checks that the last element of the container has a certain characteristic 308 | ((p-nth [0 'defn]) (-> (z/of-string \"(defn [] 1)\"))) 309 | => true 310 | 311 | ((p-nth [2 'z]) (-> (z/of-string \"[x y z]\"))) 312 | => true 313 | 314 | ((p-nth [2 'x]) (-> (z/of-string \"[y z]\"))) 315 | => false" 316 | {:added "0.1"} 317 | [[num template]] 318 | (let [template (if (symbol? template) {:is template} template) 319 | m-fn (compile-matcher template)] 320 | (Matcher. (fn [zloc] 321 | (if-let [child (->> zloc z/down)] 322 | (let [child (if (zero? num) 323 | child 324 | (-> (iterate z/next child) (nth num)))] 325 | (m-fn child))))))) 326 | 327 | (defn- p-nth-move 328 | [num template directon] 329 | (let [template (if (symbol? template) {:is template} template) 330 | m-fn (compile-matcher template)] 331 | (Matcher. (fn [zloc] 332 | (let [dir (if (zero? num) 333 | zloc 334 | (-> (iterate directon zloc) (nth num)))] 335 | (m-fn dir)))))) 336 | 337 | (defn p-nth-left 338 | "checks that the last element of the container has a certain characteristic 339 | ((p-nth-left [0 'defn]) (-> (z/of-string \"(defn [] 1)\") z/down)) 340 | => true 341 | 342 | ((p-nth-left [1 ^:% vector?]) (-> (z/of-string \"(defn [] 1)\") z/down z/rightmost)) 343 | => true" 344 | {:added "0.1"} 345 | [[num template]] 346 | (p-nth-move num template z/left)) 347 | 348 | (defn p-nth-right 349 | "checks that the last element of the container has a certain characteristic 350 | ((p-nth-right [0 'defn]) (-> (z/of-string \"(defn [] 1)\") z/down)) 351 | => true 352 | 353 | ((p-nth-right [1 ^:% vector?]) (-> (z/of-string \"(defn [] 1)\") z/down)) 354 | => true" 355 | {:added "0.1"} 356 | [[num template]] 357 | (p-nth-move num template z/right)) 358 | 359 | (defn p-nth-ancestor 360 | [[num template]] 361 | (p-nth-move num template z/up)) 362 | 363 | (defn tree-search 364 | ([zloc m-fn dir1 dir2] 365 | (if zloc 366 | (cond (nil? zloc) nil 367 | (m-fn zloc) true 368 | :else 369 | (or (tree-search (dir1 zloc) m-fn dir1 dir2) 370 | (tree-search (dir2 zloc) m-fn dir1 dir2)))))) 371 | 372 | (defn p-contains 373 | "checks that any element (deeply nested also) of the container matches 374 | ((p-contains '=) (z/of-string \"(if (= x y))\")) 375 | => true 376 | 377 | ((p-contains 'x) (z/of-string \"(if (= x y))\")) 378 | => true" 379 | {:added "0.1"} 380 | [template] 381 | (let [template (if (symbol? template) {:is template} template) 382 | m-fn (compile-matcher template)] 383 | (Matcher. (fn [zloc] 384 | (-> zloc (z/down) (tree-search m-fn z/right z/down)))))) 385 | 386 | (defn tree-depth-search 387 | ([zloc m-fn level dir1 dir2] 388 | (if zloc 389 | (cond 390 | (< level 0) nil 391 | (and (= level 0) (m-fn zloc)) true 392 | :else 393 | (or (tree-depth-search (dir1 zloc) m-fn (dec level) dir1 dir2) 394 | (tree-depth-search (dir2 zloc) m-fn level dir1 dir2)))))) 395 | 396 | (defn p-nth-contains 397 | [[num template]] 398 | (let [template (if (symbol? template) {:is template} template) 399 | m-fn (compile-matcher template)] 400 | (Matcher. (fn [zloc] 401 | (let [[dir num] (if (zero? num) 402 | [zloc num] 403 | [(z/down zloc) (dec num)])] 404 | (tree-depth-search dir m-fn num z/down z/right)))))) 405 | 406 | (defn p-ancestor 407 | "checks that any parent container matches 408 | ((p-ancestor {:form 'if}) (-> (z/of-string \"(if (= x y))\") z/down z/next z/next)) 409 | => true 410 | ((p-ancestor 'if) (-> (z/of-string \"(if (= x y))\") z/down z/next z/next)) 411 | => true" 412 | {:added "0.1"} 413 | [template] 414 | (let [template (if (symbol? template) {:form template} template) 415 | m-fn (compile-matcher template)] 416 | (Matcher. (fn [zloc] 417 | (-> zloc (z/up) (tree-search m-fn z/up (fn [_]))))))) 418 | 419 | (defn p-sibling 420 | "checks that any element on the same level has a certain characteristic 421 | ((p-sibling '=) (-> (z/of-string \"(if (= x y))\") z/down z/next z/next)) 422 | => false 423 | 424 | ((p-sibling 'x) (-> (z/of-string \"(if (= x y))\") z/down z/next z/next)) 425 | => true" 426 | {:added "0.1"} 427 | [template] 428 | (let [template (if (symbol? template) {:is template} template) 429 | m-fn (compile-matcher template)] 430 | (Matcher. (fn [zloc] 431 | (or (-> zloc z/right (tree-search m-fn z/right (fn [_]))) 432 | (-> zloc z/left (tree-search m-fn z/left (fn [_]))) 433 | false))))) 434 | 435 | (defn p-left 436 | "checks that the element on the left has a certain characteristic 437 | ((p-left '=) (-> (z/of-string \"(if (= x y))\") z/down z/next z/next z/next)) 438 | => true 439 | 440 | ((p-left 'if) (-> (z/of-string \"(if (= x y))\") z/down z/next)) 441 | => true" 442 | {:added "0.1"} 443 | [template] 444 | (let [template (if (symbol? template) {:is template} template) 445 | m-fn (compile-matcher template)] 446 | (Matcher. (fn [zloc] 447 | (if-let [left (-> zloc z/left)] 448 | (m-fn left)))))) 449 | 450 | (defn p-right 451 | "checks that the element on the right has a certain characteristic 452 | ((p-right 'x) (-> (z/of-string \"(if (= x y))\") z/down z/next z/next)) 453 | => true 454 | 455 | ((p-right {:form '=}) (-> (z/of-string \"(if (= x y))\") z/down)) 456 | => true" 457 | {:added "0.1"} 458 | [template] 459 | (let [template (if (symbol? template) {:is template} template) 460 | m-fn (compile-matcher template)] 461 | (Matcher. (fn [zloc] 462 | (if-let [right (-> zloc z/right)] 463 | (m-fn right)))))) 464 | 465 | (defn p-left-of 466 | "checks that any element on the left has a certain characteristic 467 | ((p-left-of '=) (-> (z/of-string \"(= x y)\") z/down z/next)) 468 | => true 469 | 470 | ((p-left-of '=) (-> (z/of-string \"(= x y)\") z/down z/next z/next)) 471 | => true" 472 | {:added "0.1"} 473 | [template] 474 | (let [template (if (symbol? template) {:is template} template) 475 | m-fn (compile-matcher template)] 476 | (Matcher. (fn [zloc] 477 | (or (-> zloc z/left (tree-search m-fn z/left (fn [_]))) 478 | false))))) 479 | 480 | (defn p-right-of 481 | "checks that any element on the right has a certain characteristic 482 | ((p-right-of 'x) (-> (z/of-string \"(= x y)\") z/down)) 483 | => true 484 | 485 | ((p-right-of 'y) (-> (z/of-string \"(= x y)\") z/down)) 486 | => true 487 | 488 | ((p-right-of 'z) (-> (z/of-string \"(= x y)\") z/down)) 489 | => false" 490 | {:added "0.1"} 491 | [template] 492 | (let [template (if (symbol? template) {:is template} template) 493 | m-fn (compile-matcher template)] 494 | (Matcher. (fn [zloc] 495 | (or (-> zloc z/right (tree-search m-fn z/right (fn [_]))) 496 | false))))) 497 | 498 | (defn p-left-most 499 | "checks that any element on the right has a certain characteristic 500 | ((p-left-most true) (-> (z/of-string \"(= x y)\") z/down)) 501 | => true 502 | 503 | ((p-left-most true) (-> (z/of-string \"(= x y)\") z/down z/next)) 504 | => false" 505 | {:added "0.1"} 506 | [bool] 507 | (Matcher. (fn [zloc] (= (-> zloc z/left nil?) bool)))) 508 | 509 | (defn p-right-most 510 | "checks that any element on the right has a certain characteristic 511 | ((p-right-most true) (-> (z/of-string \"(= x y)\") z/down z/next)) 512 | => false 513 | 514 | ((p-right-most true) (-> (z/of-string \"(= x y)\") z/down z/next z/next)) 515 | => true" 516 | {:added "0.1"} 517 | [bool] 518 | (Matcher. (fn [zloc] (= (-> zloc z/right nil?) bool)))) 519 | -------------------------------------------------------------------------------- /src/jai/match/actual.clj: -------------------------------------------------------------------------------- 1 | (ns jai.match.actual 2 | (:require [clojure.core.match :as match])) 3 | 4 | (defrecord ActualPattern [expression]) 5 | 6 | (defn actual-pattern [expression] 7 | (case expression 8 | '_ (ActualPattern. '(symbol "_")) 9 | (ActualPattern. expression))) 10 | 11 | (defmethod match/emit-pattern ActualPattern 12 | [pat] pat) 13 | 14 | (defmethod match/to-source ActualPattern 15 | [pat ocr] 16 | (let [v (:expression pat) 17 | v (if (-> v meta :%) (eval v) v)] 18 | `(= ~v ~ocr))) 19 | 20 | (defmethod match/groupable? [ActualPattern ActualPattern] 21 | [a b] 22 | (and (= (:expression a) 23 | (:expression b)) 24 | (= (-> a meta :%) 25 | (-> b meta :%)))) 26 | -------------------------------------------------------------------------------- /src/jai/match/eval.clj: -------------------------------------------------------------------------------- 1 | (ns jai.match.eval 2 | (:require [clojure.core.match :as match])) 3 | 4 | (defrecord EvaluationPattern [expression]) 5 | 6 | (defn eval-pattern [expression] 7 | (EvaluationPattern. expression)) 8 | 9 | (defmethod match/emit-pattern EvaluationPattern 10 | [pat] pat) 11 | 12 | (defmethod match/to-source EvaluationPattern 13 | [pat ocr] 14 | (let [v (eval (:expression pat))] 15 | (cond (fn? v) 16 | `(try (~(:expression pat) ~ocr) 17 | (catch Throwable t# false)) 18 | :else (match/to-source v)))) 19 | 20 | (defmethod match/groupable? [EvaluationPattern EvaluationPattern] 21 | [a b] 22 | (= (:expression a) 23 | (:expression b))) 24 | -------------------------------------------------------------------------------- /src/jai/match/fn.clj: -------------------------------------------------------------------------------- 1 | (ns jai.match.fn 2 | (:require [clojure.core.match :as match])) 3 | 4 | (defmethod match/emit-pattern clojure.lang.Fn 5 | [pat] 6 | (throw (ex-info "Cannot emit pattern for raw clojure functions, please use vars or prefix with ^:%" {:value pat}))) 7 | 8 | (defmethod match/emit-pattern clojure.lang.Var 9 | [pat] pat) 10 | 11 | (defmethod match/to-source clojure.lang.Var 12 | [pat ocr] 13 | (if (fn? @pat) 14 | `(try ((deref ~pat) ~ocr) 15 | (catch Throwable t# false)) 16 | `(= (deref ~pat) ~ocr))) 17 | 18 | (defmethod match/groupable? [clojure.lang.Var clojure.lang.Var] 19 | [a b] 20 | (= a b)) 21 | -------------------------------------------------------------------------------- /src/jai/match/optional.clj: -------------------------------------------------------------------------------- 1 | (ns jai.match.optional 2 | (:require [jai.common :as common])) 3 | 4 | (defn tag-meta 5 | [ele out] 6 | (let [mele (meta ele)] 7 | (cond (:? mele) 8 | (do (swap! out update-in [:?] inc) 9 | (with-meta ele (assoc mele :? (:? @out)))) 10 | 11 | :else ele))) 12 | 13 | (defn pattern-seq 14 | "generate a sequence of possible matches 15 | (pattern-seq '(+ ^:? (1) ^:? (^:? + 2))) 16 | => '((+) 17 | (+ (1)) 18 | (+ (2)) 19 | (+ (1) (2)) 20 | (+ (+ 2)) 21 | (+ (1) (+ 2)))" 22 | {:added "0.2"} 23 | [pattern] 24 | (let [out (atom {:? -1}) 25 | pattern (common/prewalk #(tag-meta % out) pattern) 26 | combos (range (bit-shift-left 1 (inc (:? @out))))] 27 | (distinct 28 | (for [combo combos] 29 | (let [hide? #(if-let [num (-> % meta :?)] 30 | (-> combo 31 | (bit-shift-right num) 32 | (mod 2) 33 | (= 0)))] 34 | (common/remove-items hide? pattern)))))) 35 | -------------------------------------------------------------------------------- /src/jai/match/pattern.clj: -------------------------------------------------------------------------------- 1 | (ns jai.match.pattern 2 | (:require [hara.common.checks :refer [hash-map? lazy-seq?]] 3 | [jai.match regex fn 4 | [actual :as actual] 5 | [eval :as eval] 6 | [optional :as optional]] 7 | [jai.common :as common] 8 | [clojure.core.match :as match] 9 | [clojure.walk :as walk])) 10 | 11 | (defn transform-pattern 12 | {:added "0.1"} 13 | [template] 14 | (cond (:& (meta template)) (actual/actual-pattern template) 15 | (:% (meta template)) (eval/eval-pattern template) 16 | (#{'(quote &) 17 | '(quote _)} template) template 18 | (or (lazy-seq? template) 19 | (list? template)) (cond (empty? template) 20 | (actual/actual-pattern template) 21 | 22 | :else 23 | (list (apply list (map transform-pattern template)) :seq)) 24 | (#{'& '_} template) template 25 | (vector? template) (vec (map transform-pattern template)) 26 | (set? template) (let [pats (map transform-pattern template) 27 | pats (if (empty? pats) [#'common/none] pats)] 28 | (apply list :or pats)) 29 | (hash-map? template) (->> (map (fn [[k v]] 30 | [(transform-pattern k) (transform-pattern v)]) template) 31 | (into {})) 32 | (symbol? template) (list 'quote template) 33 | :else template)) 34 | 35 | (defn pattern-form 36 | [sym template] 37 | (let [clauses [[(transform-pattern template)] true :else false]] 38 | (match/clj-form [sym] clauses))) 39 | 40 | (defn pattern-single-fn [template] 41 | (let [sym (gensym) 42 | match-form (pattern-form sym template) 43 | all-fn `(fn [form#] 44 | (let [~sym form#] 45 | ~match-form))] 46 | (eval all-fn))) 47 | 48 | (defn pattern-matches 49 | "pattern 50 | ((pattern-matches ()) ()) 51 | => '(()) 52 | 53 | ((pattern-matches '(^:% symbol? ^:? (+ 1 _ ^:? _))) '(+ (+ 1 2 3))) 54 | => '((^{:% true} symbol? ^{:? 0} (+ 1 _ ^{:? 1} _)))" 55 | {:added "0.2"} 56 | [template] 57 | (let [all-fns (->> template 58 | (optional/pattern-seq) 59 | (mapv (juxt identity pattern-single-fn)))] 60 | (fn [form] 61 | (or (mapcat (fn [[template f]] 62 | (if (f form) [template])) all-fns) 63 | [])))) 64 | 65 | (defn pattern-fn [template] 66 | (fn [value] 67 | (-> ((pattern-matches template) value) 68 | empty? 69 | not))) 70 | -------------------------------------------------------------------------------- /src/jai/match/regex.clj: -------------------------------------------------------------------------------- 1 | (ns jai.match.regex 2 | (:require [clojure.core.match :as match])) 3 | 4 | (defmethod match/emit-pattern java.util.regex.Pattern 5 | [pat] 6 | pat) 7 | 8 | (defmethod match/to-source java.util.regex.Pattern 9 | [pat ocr] 10 | `(cond (string? ~ocr) 11 | (re-find ~pat ~ocr) 12 | 13 | (instance? java.util.regex.Pattern ~ocr) 14 | (= (.pattern ~pat) 15 | (.pattern ~ocr)))) 16 | 17 | (defmethod match/groupable? [java.util.regex.Pattern java.util.regex.Pattern] 18 | [a b] 19 | (and (= (.pattern a) (.pattern b)) 20 | (= (.flags a) (.flags b)))) 21 | -------------------------------------------------------------------------------- /src/jai/query.clj: -------------------------------------------------------------------------------- 1 | (ns jai.query 2 | (:require [jai.match :as match] 3 | [jai.common :as common] 4 | [jai.query.compile :as compile] 5 | [jai.query.traverse :as traverse] 6 | [jai.query.walk :as walk] 7 | [rewrite-clj.zip :as source]) 8 | (:refer-clojure :exclude [find])) 9 | 10 | (defn match 11 | "matches the source code 12 | (match (source/of-string \"(+ 1 1)\") '(symbol? _ _)) 13 | => false 14 | 15 | (match (source/of-string \"(+ 1 1)\") '(^:% symbol? _ _)) 16 | => true 17 | 18 | (match (source/of-string \"(+ 1 1)\") '(^:%- symbol? _ | _)) 19 | => true 20 | 21 | (match (source/of-string \"(+ 1 1)\") '(^:%+ symbol? _ _)) 22 | => false" 23 | {:added "0.2"} 24 | [zloc selector] 25 | (let [match-fn (-> selector 26 | (compile/expand-all-metas) 27 | (common/prepare-deletion) 28 | (match/compile-matcher))] 29 | (try (match-fn zloc) 30 | (catch Throwable t false)))) 31 | 32 | (defn traverse 33 | "uses a pattern to traverse as well as to edit the form 34 | 35 | (source/sexpr 36 | (traverse (source/of-string \"^:a (+ () 2 3)\") 37 | '(+ () 2 3))) 38 | => '(+ () 2 3) 39 | 40 | (source/sexpr 41 | (traverse (source/of-string \"()\") 42 | '(^:&+ hello))) 43 | => '(hello) 44 | 45 | (source/sexpr 46 | (traverse (source/of-string \"()\") 47 | '(+ 1 2 3))) 48 | => throws 49 | 50 | (source/sexpr 51 | (traverse (source/of-string \"(defn hello \\\"world\\\" {:a 1} [])\") 52 | '(defn ^:% symbol? ^:?%- string? ^:?%- map? ^:% vector? & _))) 53 | => '(defn hello [])" 54 | {:added "0.2"} 55 | ([zloc pattern] 56 | (let [pattern (compile/expand-all-metas pattern)] 57 | (:source (traverse/traverse zloc pattern)))) 58 | ([zloc pattern func] 59 | (let [pattern (compile/expand-all-metas pattern) 60 | {:keys [level source]} (traverse/traverse zloc pattern) 61 | nsource (func source)] 62 | (if (or (nil? level) (= level 0)) 63 | nsource 64 | (nth (iterate source/up nsource) level))))) 65 | 66 | (defn select 67 | "selects all patterns from a starting point 68 | (map source/sexpr 69 | (select (source/of-string \"(defn hello [] (if (try))) (defn hello2 [] (if (try)))\") 70 | '[defn if try])) 71 | => '((defn hello [] (if (try))) 72 | (defn hello2 [] (if (try))))" 73 | {:added "0.2"} 74 | ([zloc selectors] (select zloc selectors nil)) 75 | ([zloc selectors opts] 76 | (let [[match-map [cidx ctype cform]] (compile/prepare selectors) 77 | match-fn (match/compile-matcher match-map) 78 | walk-fn (case (:walk opts) 79 | :top walk/topwalk 80 | walk/matchwalk)] 81 | (let [atm (atom [])] 82 | (walk-fn zloc 83 | [match-fn] 84 | (fn [zloc] 85 | (swap! atm conj 86 | (if (= :form ctype) 87 | (:source (traverse/traverse zloc cform)) 88 | zloc)) 89 | zloc)) 90 | (if (:first opts) 91 | (first @atm) 92 | @atm))))) 93 | 94 | (defn modify 95 | "modifies location given a function 96 | (source/root-string 97 | (modify (source/of-string \"^:a (defn hello3) (defn hello)\") ['(defn | _)] 98 | (fn [zloc] 99 | (source/insert-left zloc :hello)))) 100 | => \"^:a (defn :hello hello3) (defn :hello hello)\"" 101 | {:added "0.2"} 102 | ([zloc selectors func] (modify zloc selectors func nil)) 103 | ([zloc selectors func opts] 104 | (let [[match-map [cidx ctype cform]] (compile/prepare selectors) 105 | match-fn (match/compile-matcher match-map) 106 | walk-fn (case (:walk opts) 107 | :top walk/topwalk 108 | walk/matchwalk)] 109 | (walk-fn zloc 110 | [match-fn] 111 | (fn [zloc] 112 | (if (= :form ctype) 113 | (let [{:keys [level source]} (traverse/traverse zloc cform) 114 | nsource (func source)] 115 | 116 | (if (or (nil? level) (= level 0)) 117 | nsource 118 | (nth (iterate source/up nsource) level))) 119 | (func zloc))))))) 120 | 121 | (defn context-zloc [context] 122 | (cond (string? context) 123 | (source/of-file context) 124 | 125 | (vector? context) context 126 | 127 | (map? context) 128 | (-> (cond (:source context) 129 | (:source context) 130 | 131 | (:file context) 132 | (source/of-file (:file context)) 133 | 134 | 135 | (:string context) 136 | (source/of-string (:string context)) 137 | 138 | :else (throw (ex-info "keys can only be either :file or :string" context)))) 139 | :else (throw (ex-info "context can only be a string or map" {:value context})))) 140 | 141 | (defn wrap-vec [f] 142 | (fn [res opts] 143 | (if (vector? res) 144 | (mapv #(f % opts) res) 145 | (f res opts)))) 146 | 147 | (defn wrap-return [f] 148 | (fn [res {:keys [return] :as opts}] 149 | (case return 150 | :string (source/string (f res opts)) 151 | :zipper (f res opts) 152 | :sexpr (source/sexpr (f res opts))))) 153 | 154 | (defn $* 155 | [context path & [func? opts?]] 156 | (let [zloc (context-zloc context) 157 | [func opts] (cond (nil? func?) [nil opts?] 158 | (map? func?) [nil func?] 159 | :else [func? opts?]) 160 | results (cond func 161 | (modify zloc path func opts) 162 | 163 | :else 164 | (select zloc path opts)) 165 | opts (merge {:return (if func :zipper :sexpr)} opts)] 166 | ((-> (fn [res opts] res) 167 | wrap-return 168 | wrap-vec) results opts))) 169 | 170 | (defmacro $ 171 | "select and manipulation of clojure source code 172 | 173 | ($ {:string \"(defn hello1) (defn hello2)\"} [(defn _ ^:%+ (keyword \"oeuoeuoe\"))]) 174 | => '[(defn hello1 :oeuoeuoe) (defn hello2 :oeuoeuoe)] 175 | 176 | ($ {:string \"(defn hello1) (defn hello2)\"} [(defn _ | ^:%+ (keyword \"oeuoeuoe\") )]) 177 | => '[:oeuoeuoe :oeuoeuoe] 178 | 179 | (->> ($ {:string \"(defn hello1) (defn hello2)\"} 180 | [(defn _ | ^:%+ (keyword \"oeuoeuoe\"))] 181 | {:return :string}) 182 | ) 183 | => [\":oeuoeuoe\" \":oeuoeuoe\"] 184 | 185 | 186 | ($ (source/of-string \"a b c\") [{:is a}]) 187 | => '[a]" 188 | {:added "0.2"} 189 | [context path & args] 190 | `($* ~context (quote ~path) ~@args)) 191 | -------------------------------------------------------------------------------- /src/jai/query/compile.clj: -------------------------------------------------------------------------------- 1 | (ns jai.query.compile 2 | (:require [jai.common :as common] 3 | [jai.match :as match] 4 | [jai.query.traverse :as traverse] 5 | [jai.query.walk :as query] 6 | [clojure.walk :as walk])) 7 | 8 | (defn cursor-info 9 | "finds the information related to the cursor 10 | 11 | (cursor-info '[(defn ^:?& _ | & _)]) 12 | => '[0 :form (defn _ | & _)] 13 | 14 | (cursor-info (expand-all-metas '[(defn ^:?& _ | & _)])) 15 | => '[0 :form (defn _ | & _)] 16 | 17 | (cursor-info '[defn if]) 18 | => [nil :cursor] 19 | 20 | (cursor-info '[defn | if]) 21 | => [1 :cursor]" 22 | {:added "0.2"} 23 | [selectors] 24 | (let [candidates 25 | (->> selectors 26 | (keep-indexed 27 | (fn [i ele] 28 | (cond (= ele '|) [i :cursor] 29 | (and (list? ele) 30 | (not= (common/prepare-query ele) 31 | ele)) [i :form ele]))))] 32 | (case (count candidates) 33 | 0 (if (list? (last selectors)) 34 | [(dec (count selectors)) :form (last selectors)] 35 | [nil :cursor]) 36 | 1 (let [max (dec (count selectors)) 37 | [i type :as candidate] (first candidates) 38 | _ (case type 39 | :form (if (not= i max) 40 | (throw (Exception. "Form should be in the last position of the selectors"))) 41 | :cursor (if (= i max) 42 | (throw (Exception. "Cursor cannot be in the last position of the selectors"))))] 43 | candidate) 44 | (throw (ex-info (format "There should only be one of %s in the path." ) 45 | {:candidates candidates}))))) 46 | 47 | (defn expand-all-metas 48 | "converts the shorthand meta into a map-based meta 49 | (meta (expand-all-metas '^:%? sym?)) 50 | => {:? true, :% true} 51 | 52 | (-> (expand-all-metas '(^:%+ + 1 2)) 53 | first meta) 54 | => {:+ true, :% true}" 55 | {:added "0.2"} 56 | [selectors] 57 | (common/prewalk (fn [ele] (if (instance? clojure.lang.IObj ele) 58 | (common/expand-meta ele) 59 | ele)) 60 | selectors)) 61 | 62 | (defn split-path 63 | "splits the path into up and down 64 | (split-path '[defn | if try] [1 :cursor]) 65 | => '{:up (defn), :down [if try]} 66 | 67 | (split-path '[defn if try] [nil :cursor]) 68 | => '{:up [], :down [defn if try]}" 69 | {:added "0.2"} 70 | [selectors [idx ctype]] 71 | (let [[up down] (cond (nil? idx) 72 | [[] selectors] 73 | 74 | (= :cursor ctype) 75 | [(reverse (subvec selectors 0 idx)) 76 | (subvec selectors (inc idx) (count selectors))] 77 | 78 | (= :form ctype) 79 | [(reverse (subvec selectors 0 idx)) 80 | (subvec selectors idx (count selectors))] 81 | 82 | :else (throw (Exception. "Should not be here")))] 83 | {:up up :down down})) 84 | 85 | 86 | (defn process-special 87 | "converts a keyword into a map 88 | (process-special :*) => {:type :multi} 89 | 90 | (process-special :1) => {:type :nth, :step 1} 91 | 92 | (process-special :5) => {:type :nth, :step 5}" 93 | {:added "0.2"} 94 | [ele] 95 | (if (keyword? ele) 96 | (or (if (= :* ele) {:type :multi}) 97 | (if-let [step (try (Integer/parseInt (name ele)) 98 | (catch java.lang.NumberFormatException e))] 99 | (if (> step 0) 100 | {:type :nth :step step})) 101 | (throw (ex-info "Not a valid keyword (either :* or :)" {:value ele}))))) 102 | 103 | (defn process-path 104 | "converts a path into more information 105 | (process-path '[defn if try]) 106 | => '[{:type :step, :element defn} 107 | {:type :step, :element if} 108 | {:type :step, :element try}] 109 | 110 | (process-path '[defn :* try :3 if]) 111 | => '[{:type :step, :element defn} 112 | {:element try, :type :multi} 113 | {:element if, :type :nth, :step 3}]" 114 | {:added "0.2"} 115 | ([path] (process-path path [])) 116 | ([[x y & xs :as more] out] 117 | (if-not (empty? more) 118 | (let [xmap (process-special x) 119 | xmeta (meta x) 120 | ymap (process-special y) 121 | ymeta (meta y)] 122 | (cond (and (nil? xmap) (= 1 (count more))) 123 | (conj out (merge {:type :step :element x} xmeta)) 124 | 125 | (nil? xmap) 126 | (recur (cons y xs) 127 | (conj out (merge {:type :step :element x} xmeta))) 128 | 129 | (and xmap ymap) 130 | (recur (cons y xs) 131 | (conj out (assoc xmap :element '_))) 132 | 133 | (and xmap (= 1 (count more))) 134 | (conj out (assoc xmap :element '_)) 135 | 136 | :else 137 | (recur xs 138 | (conj out (merge (assoc xmap :element y) ymeta))))) 139 | out))) 140 | 141 | (defn compile-section-base 142 | "compiles an element section 143 | (compile-section-base '{:element defn}) 144 | => '{:form defn} 145 | 146 | (compile-section-base '{:element (if & _)}) 147 | => '{:pattern (if & _)} 148 | 149 | (compile-section-base '{:element _}) 150 | => {:is jai.common/any}" 151 | {:added "0.2"} 152 | [section] 153 | (let [{:keys [element] evaluate? :%} section] 154 | (cond evaluate? 155 | (compile-section-base (-> section 156 | (assoc :element (eval element)) 157 | (dissoc :%))) 158 | 159 | (= '_ element) {:is common/any} 160 | (fn? element) {:is element} 161 | (map? element) (walk/postwalk 162 | (fn [ele] 163 | (cond (:% (meta ele)) 164 | (eval (with-meta ele 165 | (-> (meta ele) 166 | (dissoc :%)))) 167 | :else ele)) 168 | element) 169 | (list? element) {:pattern element} 170 | (symbol? element) {:form element} 171 | :else {:is element}))) 172 | 173 | (def moves 174 | {:step {:up :parent 175 | :down :child} 176 | :multi {:up :ancestor 177 | :down :contains} 178 | :nth {:up :nth-ancestor 179 | :down :nth-contains}}) 180 | 181 | (defn compile-section 182 | "compile section 183 | (compile-section :up nil '{:element if, :type :nth, :step 3}) 184 | => '{:nth-ancestor [3 {:form if}]} 185 | 186 | (compile-section :down nil '{:element if, :type :multi}) 187 | => '{:contains {:form if}}" 188 | {:added "0.2"} 189 | [direction prev {:keys [type step] optional? :? :as section}] 190 | (let [base (-> section 191 | compile-section-base) 192 | dkey (get-in moves [type direction]) 193 | current (merge base prev) 194 | current (if optional? 195 | {:or #{current (merge {:is common/any} prev)}} 196 | current)] 197 | (if (= type :nth) 198 | {dkey [step current]} 199 | {dkey current}))) 200 | 201 | (defn compile-submap 202 | "compile submap 203 | (compile-submap :down (process-path '[if try])) 204 | => '{:child {:child {:form if}, :form try}} 205 | 206 | (compile-submap :up (process-path '[defn if])) 207 | => '{:parent {:parent {:form defn}, :form if}}" 208 | {:added "0.2"} 209 | [direction sections] 210 | (reduce (fn [i section] 211 | (compile-section direction i section)) 212 | nil sections)) 213 | 214 | (defn prepare 215 | "prepare 216 | (prepare '[defn if]) 217 | => '[{:child {:form if}, :form defn} [nil :cursor]] 218 | 219 | (prepare '[defn | if]) 220 | => '[{:parent {:form defn}, :form if} [1 :cursor]]" 221 | {:added "0.2"} 222 | [selectors] 223 | (let [selectors (expand-all-metas selectors) 224 | [cidx ctype cform :as cursor] (cursor-info selectors) 225 | qselectors (mapv (fn [ele] 226 | (if (list? ele) 227 | (common/prepare-deletion ele) ele)) 228 | selectors) 229 | {:keys [up down]} (split-path qselectors cursor) 230 | up (process-path up) 231 | [curr & down] (process-path down) 232 | match-map (merge (compile-section-base curr) 233 | (compile-submap :up (reverse up)) 234 | (compile-submap :down (reverse down)))] 235 | [match-map cursor])) 236 | -------------------------------------------------------------------------------- /src/jai/query/traverse.clj: -------------------------------------------------------------------------------- 1 | (ns jai.query.traverse 2 | (:require [rewrite-clj.zip :as source] 3 | [clojure.zip :as pattern] 4 | [jai.match.pattern :refer [pattern-matches]] 5 | [jai.match.optional :as optional] 6 | [jai.common :as common] 7 | [clojure.walk :as walk])) 8 | 9 | (defrecord Position [source pattern op] 10 | Object 11 | (toString [pos] 12 | (str "#pos" {:source (source/sexpr source) 13 | :pattern (pattern/node pattern)}))) 14 | 15 | (defmethod print-method Position 16 | [v w] 17 | (.write w (str v))) 18 | 19 | (defn pattern-zip 20 | [root] 21 | (pattern/zipper #(or (seq? %) (vector? %)) 22 | identity 23 | (fn [node children] (with-meta children (meta node))) 24 | root)) 25 | 26 | (defn wrap-meta [f] 27 | (fn [{:keys [source level] :as pos}] 28 | (if (not= :meta (source/tag source)) 29 | (f pos) 30 | (let [ppos (if level (update-in pos [:level] inc) pos) 31 | npos (f (assoc ppos :source (-> source source/down source/right)))] 32 | (if (:end npos) 33 | npos 34 | (assoc npos 35 | :source (-> (:source npos) source/up) 36 | :level level)))))) 37 | 38 | (defn wrap-delete-next [f] 39 | (fn [{:keys [source pattern next] :as pos}] 40 | (if next 41 | (if-let [nsource (source/right source)] 42 | (f (-> pos 43 | (assoc :source nsource :pattern (pattern/right pattern)) 44 | (dissoc :next))) 45 | (-> pos 46 | (assoc :source (source/up source) :pattern (pattern/up pattern)) 47 | (dissoc :next))) 48 | (f pos)))) 49 | 50 | (defn traverse-delete-form [{:keys [source pattern op] :as pos}] 51 | (let [sexpr (source/sexpr source) 52 | pnode (pattern/node pattern)] 53 | (if (empty? pnode) 54 | pos 55 | ((:delete-level op) (assoc pos 56 | :source (source/down source) 57 | :pattern (pattern/down pattern)))))) 58 | 59 | (defn traverse-delete-node [{:keys [source pattern op] :as pos}] 60 | (cond (and (source/leftmost? source) 61 | (source/rightmost? source)) 62 | (assoc pos 63 | :source (source/remove source) 64 | :pattern (pattern/up pattern)) 65 | 66 | :else 67 | ((:delete-level op) 68 | (assoc pos 69 | :source (source/remove source) 70 | :pattern pattern 71 | :next true)))) 72 | 73 | (defn traverse-delete-level [{:keys [source pattern op] :as pos}] 74 | (let [pnode (pattern/node pattern) 75 | sexpr (source/sexpr source) 76 | delete? (-> pnode meta :-)] 77 | (cond (= '& pnode) 78 | ((:delete-level op) (assoc pos 79 | :source (source/rightmost source) 80 | :pattern (pattern/rightmost pattern) 81 | :next true)) 82 | 83 | delete? 84 | ((:delete-node op) pos) 85 | 86 | (and (or (list? pnode) (vector? pnode)) 87 | (not (empty? pnode))) 88 | (-> pos 89 | ((:delete-form op)) 90 | (assoc :next true) 91 | ((:delete-level op))) 92 | 93 | :else 94 | ((:delete-level op) (assoc pos :next true))))) 95 | 96 | 97 | (defn prep-insert-pattern [pattern] 98 | (let [pnode (pattern/node pattern) 99 | {evaluate? :%} (meta pnode)] 100 | (if evaluate? (eval pnode) (with-meta pnode nil)))) 101 | 102 | (defn wrap-insert-next [f] 103 | (fn [{:keys [source pattern next] :as pos}] 104 | (if-not next 105 | (f pos) 106 | (let [nsource (source/right source) 107 | npattern (pattern/right pattern)] 108 | (cond (and nsource npattern) 109 | (f (-> pos 110 | (assoc :source nsource 111 | :pattern npattern) 112 | (dissoc :next))) 113 | 114 | (and npattern (not= '& (pattern/node npattern))) 115 | (let [inserts (->> (iterate pattern/right npattern) 116 | (take-while identity) 117 | (map prep-insert-pattern)) 118 | nsource (reduce source/insert-right source (reverse inserts))] 119 | (-> pos 120 | (assoc :source (source/up nsource) 121 | :pattern (pattern/up pattern)) 122 | (dissoc :next))) 123 | 124 | :else 125 | (-> pos 126 | (assoc :source (source/up source) :pattern (pattern/up pattern)) 127 | (dissoc :next))))))) 128 | 129 | (defn traverse-insert-form [{:keys [source pattern op] :as pos}] 130 | (let [sexpr (source/sexpr source) 131 | pnode (pattern/node pattern)] 132 | (cond (empty? pnode) 133 | pos 134 | 135 | (empty? sexpr) 136 | (assoc pos :source (reduce source/append-child source (reverse pnode))) 137 | 138 | :else 139 | ((:insert-level op) (assoc pos 140 | :source (source/down source) 141 | :pattern (pattern/down pattern)))))) 142 | 143 | (defn traverse-insert-node [{:keys [source pattern op] :as pos}] 144 | ((:insert-level op) 145 | (let [val (prep-insert-pattern pattern)] 146 | (assoc pos 147 | :source (source/left (source/insert-left source val)) 148 | :next true)))) 149 | 150 | (defn traverse-insert-level [{:keys [source pattern op] :as pos}] 151 | (let [pnode (pattern/node pattern) 152 | sexpr (source/sexpr source) 153 | insert? (-> pnode meta :+)] 154 | (cond (= '& pnode) 155 | ((:insert-level op) (assoc pos 156 | :source (source/rightmost source) 157 | :pattern (pattern/rightmost pattern) 158 | :next true)) 159 | 160 | insert? 161 | ((:insert-node op) pos) 162 | 163 | (and (or (list? pnode) (vector? pnode)) 164 | (not (empty? pnode))) 165 | (-> pos 166 | ((:insert-form op)) 167 | (assoc :next true) 168 | ((:insert-level op))) 169 | 170 | :else 171 | ((:insert-level op) (assoc pos :next true))))) 172 | 173 | (defn wrap-cursor-next [f] 174 | (fn [{:keys [source pattern next end] :as pos}] 175 | (cond end pos 176 | 177 | next 178 | (let [nsource (source/right source) 179 | npattern (pattern/right pattern)] 180 | (cond (and nsource npattern) 181 | (f (-> pos 182 | (assoc :source nsource :pattern npattern) 183 | (dissoc :next))) 184 | 185 | npattern 186 | (f (-> pos 187 | (assoc :source source :pattern npattern) 188 | (dissoc :next))) 189 | 190 | (nil? nsource) 191 | (-> pos 192 | (assoc :source (source/up source) :pattern (pattern/up pattern)) 193 | (update-in [:level] dec) 194 | (dissoc :next)))) 195 | :else (f pos)))) 196 | 197 | (defn traverse-cursor-form [{:keys [source pattern op] :as pos}] 198 | (let [sexpr (source/sexpr source) 199 | pnode (pattern/node pattern) 200 | pos (update-in pos [:level] inc)] 201 | (cond (empty? pnode) 202 | pos 203 | 204 | :else 205 | ((:cursor-level op) (assoc pos 206 | :source (source/down source) 207 | :pattern (pattern/down pattern)))))) 208 | 209 | (defn traverse-cursor-level [{:keys [source pattern op] :as pos}] 210 | (let [sexpr (source/sexpr source) 211 | pnode (pattern/node pattern)] 212 | (cond (= '| pnode) 213 | ((:cursor-level op) (assoc pos :end true)) 214 | 215 | (= '& pnode) 216 | ((:cursor-level op) (assoc pos 217 | :source (source/rightmost source) 218 | :pattern (pattern/rightmost pattern) 219 | :next true)) 220 | 221 | 222 | (and (or (list? pnode) (vector? pnode)) 223 | (not (empty? pnode))) 224 | (-> pos 225 | ((:cursor-form op)) 226 | (assoc :next true) 227 | ((:cursor-level op))) 228 | 229 | :else 230 | ((:cursor-level op) (assoc pos :next true))))) 231 | 232 | (defn count-elements [pattern] 233 | (let [sum (atom 0)] 234 | (walk/postwalk (fn [x] (swap! sum inc)) 235 | pattern) 236 | @sum)) 237 | 238 | (defn traverse [source pattern] 239 | (let [pseq (optional/pattern-seq pattern) 240 | lookup (->> pseq 241 | (map (juxt common/prepare-deletion 242 | identity)) 243 | (into {})) 244 | p-dels (->> (source/sexpr source) 245 | ((pattern-matches (common/prepare-deletion pattern)))) 246 | p-del (case (count p-dels) 247 | 0 (throw (ex-info "Needs to have a match." 248 | {:matches p-dels 249 | :source (source/sexpr source) 250 | :pattern pattern})) 251 | 1 (first p-dels) 252 | (->> p-dels 253 | (sort-by count-elements) 254 | (last))) 255 | p-match (get lookup p-del) 256 | p-ins (common/prepare-insertion p-match) 257 | op-del {:delete-form (wrap-meta traverse-delete-form) 258 | :delete-level (wrap-delete-next traverse-delete-level) 259 | :delete-node traverse-delete-node} 260 | 261 | del-pos (-> (map->Position {:source source 262 | :pattern (pattern-zip p-del) 263 | :op op-del}) 264 | ((:delete-form op-del))) 265 | 266 | op-ins {:insert-form (wrap-meta traverse-insert-form) 267 | :insert-level (wrap-insert-next traverse-insert-level) 268 | :insert-node traverse-insert-node} 269 | ins-pos (-> del-pos 270 | (assoc :pattern (pattern-zip p-ins) 271 | :op op-ins) 272 | ((:insert-form op-ins))) 273 | p-cursor (common/remove-items common/deletion? p-match)] 274 | (if (= p-cursor p-ins) 275 | ins-pos 276 | (let [op-cursor {:cursor-form (wrap-meta traverse-cursor-form) 277 | :cursor-level (wrap-cursor-next traverse-cursor-level)} 278 | cursor-pos (-> ins-pos 279 | (assoc :pattern (pattern-zip p-cursor) 280 | :op op-cursor 281 | :level 0) 282 | ((:cursor-form op-cursor)))] 283 | cursor-pos)))) 284 | -------------------------------------------------------------------------------- /src/jai/query/walk.clj: -------------------------------------------------------------------------------- 1 | (ns jai.query.walk 2 | (:require [rewrite-clj.zip :as z])) 3 | 4 | (defn matchwalk-base 5 | [zloc [m & more :as matchers] f recur-fn] 6 | (let [nloc (if (m zloc) 7 | (cond (empty? more) 8 | (f zloc) 9 | 10 | (z/down zloc) 11 | (z/up (recur-fn (z/down zloc) more f recur-fn)) 12 | 13 | :else 14 | zloc) 15 | zloc) 16 | nloc (if-let [zdown (z/down nloc)] 17 | (z/up (recur-fn zdown matchers f recur-fn)) 18 | nloc) 19 | nloc (if-let [zright (z/right nloc)] 20 | (z/left (recur-fn zright matchers f recur-fn)) 21 | nloc)] 22 | nloc)) 23 | 24 | (defn wrap-meta [walk-fn] 25 | (fn [zloc matchers f recur-fn] 26 | (if (= :meta (z/tag zloc)) 27 | (let [nloc (z/up (walk-fn (-> zloc z/down z/right) matchers f recur-fn))] 28 | (if (z/right nloc) 29 | (walk-fn (z/right nloc) matchers f recur-fn) 30 | nloc)) 31 | (walk-fn zloc matchers f recur-fn)))) 32 | 33 | (defn matchwalk [zloc matchers f] 34 | ((wrap-meta matchwalk-base) zloc matchers f (wrap-meta matchwalk-base))) 35 | 36 | (defn topwalk-base 37 | [zloc [matcher] f recur-fn] 38 | (let [nloc (if (matcher zloc) 39 | (f zloc) 40 | zloc) 41 | nloc (if-let [zright (z/right nloc)] 42 | (z/left (recur-fn zright [matcher] f recur-fn)) 43 | nloc)] 44 | nloc)) 45 | 46 | (defn topwalk [zloc [matcher] f] 47 | ((wrap-meta topwalk-base) zloc [matcher] f (wrap-meta topwalk-base))) 48 | -------------------------------------------------------------------------------- /test/jai/common_test.clj: -------------------------------------------------------------------------------- 1 | (ns jai.common-test 2 | (:use [hara.test :exclude [any]]) 3 | (:require [jai.common :refer :all])) 4 | 5 | ^{:refer jai.common/any :added "0.2"} 6 | (fact "returns true for any value" 7 | (any nil) => true 8 | (any '_) => true) 9 | 10 | ^{:refer jai.common/none :added "0.2"} 11 | (fact "returns false for any value" 12 | (none nil) => false 13 | (none '_) => false) 14 | 15 | ^{:refer jai.common/expand-meta :added "0.2"} 16 | (fact "separates out the meta into individual flags" 17 | (meta (expand-meta ^:? ())) 18 | => {:? true} 19 | (meta (expand-meta ^:+%? ())) 20 | => {:+ true, :? true, :% true}) 21 | 22 | ^{:refer jai.common/cursor? :added "0.2"} 23 | (fact "checks if element is `|`" 24 | (cursor? '|) => true 25 | (cursor? '_) => false) 26 | 27 | ^{:refer jai.common/insertion? :added "0.2"} 28 | (fact "checks if element has an insert meta" 29 | (insertion? '^:+ a) => true 30 | (insertion? 'a) => false) 31 | 32 | ^{:refer jai.common/deletion? :added "0.2"} 33 | (fact "checks if element has a delete meta" 34 | (deletion? '^:- a) => true 35 | (deletion? 'a) => false) 36 | 37 | ^{:refer jai.common/remove-items :added "0.2"} 38 | (fact "removes items from a form matching the predicate" 39 | (remove-items #(= 1 %) '(1 2 3 4)) 40 | => '(2 3 4) 41 | 42 | (remove-items #(= 1 %) '(1 (1 (1 (1))))) 43 | => '(((())))) 44 | 45 | ^{:refer jai.common/prepare-deletion :added "0.2"} 46 | (fact "removes extraneous symbols for deletion walk" 47 | (prepare-deletion '(+ a 2)) 48 | => '(+ a 2) 49 | 50 | (prepare-deletion '(+ ^:+ a | 2)) 51 | => '(+ 2)) 52 | 53 | ^{:refer jai.common/prepare-insertion :added "0.2"} 54 | (fact "removes extraneous symbols for deletion walk" 55 | (prepare-insertion '(+ a 2)) 56 | => '(+ a 2) 57 | 58 | (prepare-insertion '(+ ^:+ a | ^:- b 2)) 59 | => '(+ a 2)) 60 | 61 | ^{:refer jai.common/find-index :added "0.2"} 62 | (fact "returns the index of the first occurrence" 63 | (find-index #(= 2 %) '(1 2 3 4)) 64 | => 1) 65 | 66 | ^{:refer jai.common/finto :added "0.2"} 67 | (fact "into but the right way for lists" 68 | (finto () '(1 2 3)) 69 | => '(1 2 3)) 70 | -------------------------------------------------------------------------------- /test/jai/match/fn_test.clj: -------------------------------------------------------------------------------- 1 | (ns jai.match.fn-test 2 | (:use hara.test) 3 | (:require [jai.match [pattern :refer :all] fn])) 4 | 5 | ^{:refer jai.match.fn/pattern-fn :added "0.2"} 6 | (fact "make sure that functions are working properly" 7 | ((pattern-fn vector?) []) 8 | => throws 9 | 10 | ((pattern-fn #'vector?) []) 11 | => true 12 | 13 | ((pattern-fn '^:% vector?) []) 14 | => true 15 | 16 | ((pattern-fn '^:% symbol?) []) 17 | => false 18 | 19 | ((pattern-fn '[^:% vector?]) [[]]) 20 | => true) 21 | -------------------------------------------------------------------------------- /test/jai/match/optional_test.clj: -------------------------------------------------------------------------------- 1 | (ns jai.match.optional-test 2 | (:use hara.test) 3 | (:require [jai.match.optional :refer :all])) 4 | 5 | ^{:refer jai.match.optional/pattern-seq :added "0.2"} 6 | (fact "generate a sequence of possible matches" 7 | (pattern-seq '(+ ^:? (1) ^:? (^:? + 2))) 8 | => '((+) 9 | (+ (1)) 10 | (+ (2)) 11 | (+ (1) (2)) 12 | (+ (+ 2)) 13 | (+ (1) (+ 2)))) 14 | 15 | 16 | -------------------------------------------------------------------------------- /test/jai/match/pattern_test.clj: -------------------------------------------------------------------------------- 1 | (ns jai.match.pattern-test 2 | (:use hara.test) 3 | (:require [jai.match.pattern :refer :all])) 4 | 5 | ^{:refer jai.match.pattern/pattern-matches :added "0.2"} 6 | (fact "pattern" 7 | ((pattern-matches ()) ()) 8 | => '(()) 9 | 10 | ((pattern-matches '(^:% symbol? ^:? (+ 1 _ ^:? _))) '(+ (+ 1 2 3))) 11 | => '((^{:% true} symbol? ^{:? 0} (+ 1 _ ^{:? 1} _)))) 12 | 13 | 14 | (set! *print-meta* false) 15 | 16 | (comment) 17 | 18 | -------------------------------------------------------------------------------- /test/jai/match/set_test.clj: -------------------------------------------------------------------------------- 1 | (ns jai.match.set-test 2 | (:use hara.test) 3 | (:require [jai.match.pattern :refer :all] 4 | [clojure.core.match :as match])) 5 | 6 | ^{:refer jai.match.set/pattern-fn :added "0.2"} 7 | (fact "make sure that sets are working properly" 8 | (transform-pattern #{1 2 3}) 9 | => '(:or 1 3 2) 10 | 11 | ((pattern-fn #{1 2 3}) 3) 12 | => true 13 | 14 | ((pattern-fn #{1 2 3}) 4) 15 | => false 16 | 17 | ((pattern-fn #{'defn}) 'defn) 18 | => true 19 | 20 | ((pattern-fn #{#'symbol?}) 'defn) 21 | => true 22 | 23 | ((pattern-fn '#{^:% symbol? 1 2 3}) 'defn) 24 | => true 25 | 26 | ((pattern-fn '#{}) 'defn) 27 | => false 28 | 29 | ((pattern-fn #{1 2 3}) #{1 2 3}) 30 | => false 31 | 32 | ((pattern-fn ^:& #{1 2 3}) #{1 2 3}) 33 | => true) 34 | -------------------------------------------------------------------------------- /test/jai/match_test.clj: -------------------------------------------------------------------------------- 1 | (ns jai.match-test 2 | (:use hara.test) 3 | (:require [jai.match :refer :all] 4 | [rewrite-clj.zip :as z])) 5 | 6 | ^{:refer jai.match/p-fn :added "0.1"} 7 | (fact "takes a predicate function to check the state of the zipper" 8 | ((p-fn (fn [x] 9 | (-> (z/node x) (.tag) (= :token)))) 10 | (z/of-string "defn")) 11 | => true) 12 | 13 | ^{:refer jai.match/p-is :added "0.1"} 14 | (fact "checks if node is equivalent, does not meta into account" 15 | ((p-is 'defn) (z/of-string "defn")) 16 | => true 17 | 18 | ((p-is '^{:a 1} defn) (z/of-string "defn")) 19 | => true 20 | 21 | ((p-is 'defn) (z/of-string "is")) 22 | => false 23 | 24 | ((p-is '(defn & _)) (z/of-string "(defn x [])")) 25 | => false) 26 | 27 | ^{:refer jai.match/p-equal :added "0.1"} 28 | (fact "checks if the node is equivalent, takes meta into account" 29 | ((p-equal '^{:a 1} defn) (z/of-string "defn")) 30 | => false 31 | 32 | ((p-equal '^{:a 1} defn) (z/of-string "^{:a 1} defn")) 33 | => true 34 | 35 | ((p-equal '^{:a 1} defn) (z/of-string "^{:a 2} defn")) 36 | => false) 37 | 38 | ^{:refer jai.match/p-meta :added "0.1"} 39 | (fact "checks if meta is the same" 40 | ((p-meta {:a 1}) (z/down (z/of-string "^{:a 1} defn"))) 41 | => true 42 | 43 | ((p-meta {:a 1}) (z/down (z/of-string "^{:a 2} defn"))) 44 | => false) 45 | 46 | ^{:refer jai.match/p-type :added "0.1"} 47 | (fact "check on the type of element" 48 | ((p-type :token) (z/of-string "defn")) 49 | => true 50 | 51 | ((p-type :token) (-> (z/of-string "^{:a 1} defn") z/down z/right)) 52 | => true) 53 | 54 | ^{:refer jai.match/p-form :added "0.1"} 55 | (fact "checks if it is a form with the symbol as the first element" 56 | ((p-form 'defn) (z/of-string "(defn x [])")) 57 | => true 58 | ((p-form 'let) (z/of-string "(let [])")) 59 | => true) 60 | 61 | ^{:refer jai.match/p-pattern :added "0.1"} 62 | (fact "checks if the form matches a particular pattern" 63 | ((p-pattern '(defn ^:% symbol? & _)) (z/of-string "(defn ^{:a 1} x [])")) 64 | => true 65 | 66 | ((p-pattern '(defn ^:% symbol? ^{:% true :? true} string? [])) 67 | (z/of-string "(defn ^{:a 1} x [])")) 68 | => true) 69 | 70 | ^{:refer jai.match/p-code :added "0.1"} 71 | (fact "checks if the form matches a string in the form of a regex expression" 72 | ((p-code #"defn") (z/of-string "(defn ^{:a 1} x [])")) 73 | => true) 74 | 75 | ^{:refer jai.match/p-and :added "0.1"} 76 | (fact "takes multiple predicates and ensures that all are correct" 77 | ((p-and (p-code #"defn") 78 | (p-type :token)) (z/of-string "(defn ^{:a 1} x [])")) 79 | => false 80 | 81 | ((p-and (p-code #"defn") 82 | (p-type :list)) (z/of-string "(defn ^{:a 1} x [])")) 83 | => true) 84 | 85 | ^{:refer jai.match/p-or :added "0.1"} 86 | (fact "takes multiple predicates and ensures that at least one is correct" 87 | ((p-or (p-code #"defn") 88 | (p-type :token)) (z/of-string "(defn ^{:a 1} x [])")) 89 | => true 90 | 91 | ((p-or (p-code #"defn") 92 | (p-type :list)) (z/of-string "(defn ^{:a 1} x [])")) 93 | => true) 94 | 95 | ^{:refer jai.match/p-parent :added "0.1"} 96 | (fact "checks that the parent of the element contains a certain characteristic" 97 | ((p-parent 'defn) (-> (z/of-string "(defn x [])") z/next z/next)) 98 | => true 99 | 100 | ((p-parent {:parent 'if}) (-> (z/of-string "(if (= x y))") z/down z/next z/next)) 101 | => true 102 | 103 | ((p-parent {:parent 'if}) (-> (z/of-string "(if (= x y))") z/down)) 104 | => false) 105 | 106 | ^{:refer jai.match/p-child :added "0.1"} 107 | (fact "checks that there is a child of a container that has a certain characteristic" 108 | ((p-child {:form '=}) (z/of-string "(if (= x y))")) 109 | => true 110 | 111 | ((p-child '=) (z/of-string "(if (= x y))")) 112 | => false) 113 | 114 | ^{:refer jai.match/p-first :added "0.1"} 115 | (fact "checks that the first element of the container has a certain characteristic" 116 | ((p-first 'defn) (-> (z/of-string "(defn x [])"))) 117 | => true 118 | 119 | ((p-first 'x) (-> (z/of-string "[x y z]"))) 120 | => true 121 | 122 | ((p-first 'x) (-> (z/of-string "[y z]"))) 123 | => false) 124 | 125 | ^{:refer jai.match/p-last :added "0.1"} 126 | (fact "checks that the last element of the container has a certain characteristic" 127 | ((p-last 1) (-> (z/of-string "(defn [] 1)"))) 128 | => true 129 | 130 | ((p-last 'z) (-> (z/of-string "[x y z]"))) 131 | => true 132 | 133 | ((p-last 'x) (-> (z/of-string "[y z]"))) 134 | => false) 135 | 136 | 137 | ^{:refer jai.match/p-nth :added "0.1"} 138 | (fact "checks that the last element of the container has a certain characteristic" 139 | ((p-nth [0 'defn]) (-> (z/of-string "(defn [] 1)"))) 140 | => true 141 | 142 | ((p-nth [2 'z]) (-> (z/of-string "[x y z]"))) 143 | => true 144 | 145 | ((p-nth [2 'x]) (-> (z/of-string "[y z]"))) 146 | => false) 147 | 148 | 149 | ^{:refer jai.match/p-nth-left :added "0.1"} 150 | (fact "checks that the last element of the container has a certain characteristic" 151 | ((p-nth-left [0 'defn]) (-> (z/of-string "(defn [] 1)") z/down)) 152 | => true 153 | 154 | ((p-nth-left [1 ^:% vector?]) (-> (z/of-string "(defn [] 1)") z/down z/rightmost)) 155 | => true) 156 | 157 | 158 | ^{:refer jai.match/p-nth-right :added "0.1"} 159 | (fact "checks that the last element of the container has a certain characteristic" 160 | ((p-nth-right [0 'defn]) (-> (z/of-string "(defn [] 1)") z/down)) 161 | => true 162 | 163 | ((p-nth-right [1 ^:% vector?]) (-> (z/of-string "(defn [] 1)") z/down)) 164 | => true) 165 | 166 | 167 | 168 | ^{:refer jai.match/p-contains :added "0.1"} 169 | (fact "checks that any element (deeply nested also) of the container matches" 170 | ((p-contains '=) (z/of-string "(if (= x y))")) 171 | => true 172 | 173 | ((p-contains 'x) (z/of-string "(if (= x y))")) 174 | => true) 175 | 176 | ^{:refer jai.match/p-ancestor :added "0.1"} 177 | (fact "checks that any parent container matches" 178 | ((p-ancestor {:form 'if}) (-> (z/of-string "(if (= x y))") z/down z/next z/next)) 179 | => true 180 | ((p-ancestor 'if) (-> (z/of-string "(if (= x y))") z/down z/next z/next)) 181 | => true) 182 | 183 | ^{:refer jai.match/p-sibling :added "0.1"} 184 | (fact "checks that any element on the same level has a certain characteristic" 185 | ((p-sibling '=) (-> (z/of-string "(if (= x y))") z/down z/next z/next)) 186 | => false 187 | 188 | ((p-sibling 'x) (-> (z/of-string "(if (= x y))") z/down z/next z/next)) 189 | => true) 190 | 191 | ^{:refer jai.match/p-left :added "0.1"} 192 | (fact "checks that the element on the left has a certain characteristic" 193 | ((p-left '=) (-> (z/of-string "(if (= x y))") z/down z/next z/next z/next)) 194 | => true 195 | 196 | ((p-left 'if) (-> (z/of-string "(if (= x y))") z/down z/next)) 197 | => true) 198 | 199 | ^{:refer jai.match/p-right :added "0.1"} 200 | (fact "checks that the element on the right has a certain characteristic" 201 | ((p-right 'x) (-> (z/of-string "(if (= x y))") z/down z/next z/next)) 202 | => true 203 | 204 | ((p-right {:form '=}) (-> (z/of-string "(if (= x y))") z/down)) 205 | => true) 206 | 207 | ^{:refer jai.match/p-left-of :added "0.1"} 208 | (fact "checks that any element on the left has a certain characteristic" 209 | ((p-left-of '=) (-> (z/of-string "(= x y)") z/down z/next)) 210 | => true 211 | 212 | ((p-left-of '=) (-> (z/of-string "(= x y)") z/down z/next z/next)) 213 | => true) 214 | 215 | ^{:refer jai.match/p-right-of :added "0.1"} 216 | (fact "checks that any element on the right has a certain characteristic" 217 | ((p-right-of 'x) (-> (z/of-string "(= x y)") z/down)) 218 | => true 219 | 220 | ((p-right-of 'y) (-> (z/of-string "(= x y)") z/down)) 221 | => true 222 | 223 | ((p-right-of 'z) (-> (z/of-string "(= x y)") z/down)) 224 | => false) 225 | 226 | 227 | ^{:refer jai.match/p-left-most :added "0.1"} 228 | (fact "checks that any element on the right has a certain characteristic" 229 | ((p-left-most true) (-> (z/of-string "(= x y)") z/down)) 230 | => true 231 | 232 | ((p-left-most true) (-> (z/of-string "(= x y)") z/down z/next)) 233 | => false) 234 | 235 | 236 | ^{:refer jai.match/p-right-most :added "0.1"} 237 | (fact "checks that any element on the right has a certain characteristic" 238 | ((p-right-most true) (-> (z/of-string "(= x y)") z/down z/next)) 239 | => false 240 | 241 | ((p-right-most true) (-> (z/of-string "(= x y)") z/down z/next z/next)) 242 | => true) 243 | -------------------------------------------------------------------------------- /test/jai/query/compile_test.clj: -------------------------------------------------------------------------------- 1 | (ns jai.query.compile-test 2 | (:use hara.test) 3 | (:require [jai.query.compile :refer :all] 4 | [rewrite-clj.zip :as source])) 5 | 6 | ^{:refer jai.query.compile/cursor-info :added "0.2"} 7 | (fact "finds the information related to the cursor" 8 | 9 | (cursor-info '[(defn ^:?& _ | & _)]) 10 | => '[0 :form (defn _ | & _)] 11 | 12 | (cursor-info (expand-all-metas '[(defn ^:?& _ | & _)])) 13 | => '[0 :form (defn _ | & _)] 14 | 15 | (cursor-info '[defn if]) 16 | => [nil :cursor] 17 | 18 | (cursor-info '[defn | if]) 19 | => [1 :cursor]) 20 | 21 | ^{:refer jai.query.compile/expand-all-metas :added "0.2"} 22 | (fact "converts the shorthand meta into a map-based meta" 23 | (meta (expand-all-metas '^:%? sym?)) 24 | => {:? true, :% true} 25 | 26 | (-> (expand-all-metas '(^:%+ + 1 2)) 27 | first meta) 28 | => {:+ true, :% true}) 29 | 30 | ^{:refer jai.query.compile/split-path :added "0.2"} 31 | (fact "splits the path into up and down" 32 | (split-path '[defn | if try] [1 :cursor]) 33 | => '{:up (defn), :down [if try]} 34 | 35 | (split-path '[defn if try] [nil :cursor]) 36 | => '{:up [], :down [defn if try]}) 37 | 38 | ^{:refer jai.query.compile/process-special :added "0.2"} 39 | (fact "converts a keyword into a map" 40 | (process-special :*) => {:type :multi} 41 | 42 | (process-special :1) => {:type :nth, :step 1} 43 | 44 | (process-special :5) => {:type :nth, :step 5}) 45 | 46 | ^{:refer jai.query.compile/process-path :added "0.2"} 47 | (fact "converts a path into more information" 48 | (process-path '[defn if try]) 49 | => '[{:type :step, :element defn} 50 | {:type :step, :element if} 51 | {:type :step, :element try}] 52 | 53 | (process-path '[defn :* try :3 if]) 54 | => '[{:type :step, :element defn} 55 | {:element try, :type :multi} 56 | {:element if, :type :nth, :step 3}]) 57 | 58 | ^{:refer jai.query.compile/compile-section-base :added "0.2"} 59 | (fact "compiles an element section" 60 | (compile-section-base '{:element defn}) 61 | => '{:form defn} 62 | 63 | (compile-section-base '{:element (if & _)}) 64 | => '{:pattern (if & _)} 65 | 66 | (compile-section-base '{:element _}) 67 | => {:is jai.common/any}) 68 | 69 | ^{:refer jai.query.compile/compile-section :added "0.2"} 70 | (fact "compile section" 71 | (compile-section :up nil '{:element if, :type :nth, :step 3}) 72 | => '{:nth-ancestor [3 {:form if}]} 73 | 74 | (compile-section :down nil '{:element if, :type :multi}) 75 | => '{:contains {:form if}}) 76 | 77 | ^{:refer jai.query.compile/compile-submap :added "0.2"} 78 | (fact "compile submap" 79 | (compile-submap :down (process-path '[if try])) 80 | => '{:child {:child {:form if}, :form try}} 81 | 82 | (compile-submap :up (process-path '[defn if])) 83 | => '{:parent {:parent {:form defn}, :form if}}) 84 | 85 | ^{:refer jai.query.compile/prepare :added "0.2"} 86 | (fact "prepare" 87 | (prepare '[defn if]) 88 | => '[{:child {:form if}, :form defn} [nil :cursor]] 89 | 90 | (prepare '[defn | if]) 91 | => '[{:parent {:form defn}, :form if} [1 :cursor]]) 92 | 93 | (comment 94 | (require '[rewrite-clj.zip :as z]) 95 | 96 | (cursor-info '[(defn ^:?& _ | & _)]) 97 | 98 | (cursor-info (expand-all-metas '[(defn ^:?& _ | & _)])) 99 | 100 | (potential-cursors (expand-all-metas '[(defn & _)])) 101 | 102 | ($ nil [(defn _ | & _)]) 103 | 104 | (set! *print-meta* (not *print-meta*)) 105 | ) 106 | -------------------------------------------------------------------------------- /test/jai/query/traverse_test.clj: -------------------------------------------------------------------------------- 1 | (ns jai.query.traverse-test 2 | (:use hara.test) 3 | (:require [rewrite-clj.zip :as source] 4 | [clojure.zip :as zip] 5 | [jai.query.traverse :refer :all])) 6 | 7 | ^{:refer jai.traverse/traverse-basic :added "0.2"} 8 | (defn source [pos] 9 | (-> pos :source source/sexpr)) 10 | 11 | ^{:refer jai.traverse/traverse-basic :added "0.2"} 12 | (fact 13 | (source 14 | (traverse (source/of-string "^:a (+ () 2 3)") 15 | '(+ () 2 3))) 16 | => '(+ () 2 3) 17 | 18 | (source 19 | (traverse (source/of-string "^:a (hello)") 20 | '(hello))) 21 | => '(hello) 22 | 23 | (source 24 | (traverse (source/of-string "^:a (hello)") 25 | '(^:- hello))) 26 | => () 27 | 28 | (source 29 | (traverse (source/of-string "(hello)") 30 | '(^:- hello))) 31 | => () 32 | 33 | (source 34 | (traverse (source/of-string "((hello))") 35 | '((^:- hello)))) 36 | => '(()) 37 | 38 | ;; Insertions 39 | (source 40 | (traverse (source/of-string "()") 41 | '(^:+ hello))) 42 | => '(hello) 43 | 44 | (source 45 | (traverse (source/of-string "(())") 46 | '((^:+ hello)))) 47 | => '((hello))) 48 | 49 | ^{:refer jai.traverse/traverse-advance :added "0.2"} 50 | (fact 51 | (source 52 | (traverse (source/of-string "(defn hello)") 53 | '(defn ^{:? true :% true} symbol? ^:+ []))) 54 | => '(defn hello []) 55 | 56 | (source 57 | (traverse (source/of-string "(defn hello)") 58 | '(defn ^{:? true :% true :- true} symbol? ^:+ []))) 59 | => '(defn []) 60 | 61 | (source 62 | (traverse (source/of-string "(defn hello)") 63 | '(defn ^{:? true :% true :- true} symbol? | ^:+ []))) 64 | => [] 65 | 66 | (source 67 | (traverse (source/of-string "(defn hello \"world\" {:a 1} [])") 68 | '(defn ^:% symbol? 69 | ^{:? true :% true :- true} string? 70 | ^{:? true :% true :- true} map? 71 | ^:% vector? & _))) 72 | => '(defn hello []) 73 | 74 | (source 75 | (traverse (source/of-string "(defn hello [] (+ 1 1))") 76 | '(defn _ _ (+ | 1 & _)))) 77 | => 1 78 | 79 | (source 80 | (traverse (source/of-string "(defn hello [] (+ 1 1))") 81 | '(#{defn} | & _ ))) 82 | => 'hello 83 | 84 | (source 85 | (traverse (source/of-string "(fact \"hello world\")") 86 | '(fact | & _ ))) 87 | => "hello world") 88 | -------------------------------------------------------------------------------- /test/jai/query_test.clj: -------------------------------------------------------------------------------- 1 | (ns jai.query-test 2 | (:use hara.test) 3 | (:require [jai.query :refer :all] 4 | [rewrite-clj.zip :as source])) 5 | 6 | ^{:refer jai.query/match :added "0.2"} 7 | (fact "matches the source code" 8 | (match (source/of-string "(+ 1 1)") '(symbol? _ _)) 9 | => false 10 | 11 | (match (source/of-string "(+ 1 1)") '(^:% symbol? _ _)) 12 | => true 13 | 14 | (match (source/of-string "(+ 1 1)") '(^:%- symbol? _ | _)) 15 | => true 16 | 17 | (match (source/of-string "(+ 1 1)") '(^:%+ symbol? _ _)) 18 | => false) 19 | 20 | ^{:refer jai.query/traverse :added "0.2"} 21 | (fact "uses a pattern to traverse as well as to edit the form" 22 | 23 | (source/sexpr 24 | (traverse (source/of-string "^:a (+ () 2 3)") 25 | '(+ () 2 3))) 26 | => '(+ () 2 3) 27 | 28 | (source/sexpr 29 | (traverse (source/of-string "()") 30 | '(^:&+ hello))) 31 | => '(hello) 32 | 33 | (source/sexpr 34 | (traverse (source/of-string "()") 35 | '(+ 1 2 3))) 36 | => throws 37 | 38 | (source/sexpr 39 | (traverse (source/of-string "(defn hello \"world\" {:a 1} [])") 40 | '(defn ^:% symbol? ^:?%- string? ^:?%- map? ^:% vector? & _))) 41 | => '(defn hello [])) 42 | 43 | ^{:refer jai.query/select :added "0.2"} 44 | (fact "selects all patterns from a starting point" 45 | (map source/sexpr 46 | (select (source/of-string "(defn hello [] (if (try))) (defn hello2 [] (if (try)))") 47 | '[defn if try])) 48 | => '((defn hello [] (if (try))) 49 | (defn hello2 [] (if (try))))) 50 | 51 | ^{:refer jai.query/modify :added "0.2"} 52 | (fact "modifies location given a function" 53 | (source/root-string 54 | (modify (source/of-string "^:a (defn hello3) (defn hello)") ['(defn | _)] 55 | (fn [zloc] 56 | (source/insert-left zloc :hello)))) 57 | => "^:a (defn :hello hello3) (defn :hello hello)") 58 | 59 | ^{:refer jai.query/$ :added "0.2"} 60 | (fact "select and manipulation of clojure source code" 61 | 62 | ($ {:string "(defn hello1) (defn hello2)"} [(defn _ ^:%+ (keyword "oeuoeuoe"))]) 63 | => '[(defn hello1 :oeuoeuoe) (defn hello2 :oeuoeuoe)] 64 | 65 | ($ {:string "(defn hello1) (defn hello2)"} [(defn _ | ^:%+ (keyword "oeuoeuoe") )]) 66 | => '[:oeuoeuoe :oeuoeuoe] 67 | 68 | (->> ($ {:string "(defn hello1) (defn hello2)"} 69 | [(defn _ | ^:%+ (keyword "oeuoeuoe"))] 70 | {:return :string}) 71 | ) 72 | => [":oeuoeuoe" ":oeuoeuoe"] 73 | 74 | 75 | ($ (source/of-string "a b c") [{:is a}]) 76 | => '[a]) 77 | -------------------------------------------------------------------------------- /test/jai/readme_test.clj: -------------------------------------------------------------------------------- 1 | (ns jai.readme-test 2 | (:use hara.test) 3 | (:require [jai.query :refer :all] 4 | [rewrite-clj.zip :as z])) 5 | 6 | 7 | [[:chapter {:title "Introduction"}]] 8 | 9 | "`jai` that makes it easy for querying and manipulation of clojure source code through an `xpath`/`css`-inspired syntax 10 | 11 | - to simplify traversal and manipulation of source code 12 | - to provide higher level abstractions on top of [rewrite-clj](https://github.com/xsc/rewrite-clj) 13 | - to leverage [core.match](https://github.com/clojure/core.match)'s pattern matching for a more declarative syntax" 14 | 15 | 16 | [[:chapter {:title "Installation"}]] 17 | 18 | "Add to `project.clj` dependencies: 19 | 20 | `[im.chit/jai `\"`{{PROJECT.version}}`\"`]` 21 | 22 | 23 | All functionality is in the `jai.query` namespace: 24 | " 25 | 26 | (comment 27 | (use jai.query)) 28 | 29 | [[:chapter {:title "Usage"}]] 30 | 31 | 32 | "We first define a code fragment to query on. The library currently works with strings and files." 33 | 34 | (def fragment {:string "(defn hello [] (println \"hello\"))\n 35 | (defn world [] (if true (prn \"world\")))"}) 36 | 37 | [[:section {:title "Basics"}]] 38 | 39 | "Find all the `defn` forms:" 40 | 41 | (fact 42 | ($ fragment [defn]) 43 | => '[(defn hello [] (println "hello")) 44 | (defn world [] (if true (prn "world")))]) 45 | 46 | "Find all the `if` forms" 47 | 48 | (fact 49 | ($ fragment [if]) 50 | => '((if true (prn "world")))) 51 | 52 | [[:section {:title "Path"}]] 53 | 54 | "Find all the `defn` forms that contain an `if` form directly below it:" 55 | 56 | (fact 57 | ($ fragment [defn if]) 58 | => '[(defn world [] (if true (prn "world")))]) 59 | 60 | "Find all the `defn` forms that contains a `prn` form anywhere in its body" 61 | 62 | (fact 63 | ($ fragment [defn :* prn]) 64 | => '[(defn world [] (if true (prn "world")))]) 65 | 66 | "Depth searching at specific levels can also be done, the following code performs 67 | a search for `prn` at the second and third level forms below the `defn`:" 68 | 69 | (fact 70 | ($ fragment [defn :2 prn]) 71 | => '[(defn world [] (if true (prn "world")))] 72 | 73 | ($ fragment [defn :3 prn]) 74 | => '[]) 75 | 76 | [[:section {:title "Representation"}]] 77 | 78 | "Instead of returning an s-expression, we can also return other represetations through specifying the `:return` value on the code. The options are `:zipper`, `:sexpr` or `:string`." 79 | 80 | "By default, querying returns a `:sexpr` representation" 81 | (fact 82 | ($ (assoc fragment :return :sexpr) [defn :* prn]) 83 | => '[(defn world [] (if true (prn "world")))]) 84 | 85 | "String representations are useful for directly writing to file" 86 | 87 | (fact 88 | ($ fragment [defn :* prn] {:return :string}) 89 | => ["(defn world [] (if true (prn \"world\")))"]) 90 | 91 | "If more manipulation is needed, then returning a zipper allows composablity with rewrite-clj" 92 | 93 | (fact 94 | (->> ($ fragment [defn :* prn] {:return :zipper}) 95 | (map z/sexpr)) 96 | => '[(defn world [] (if true (prn "world")))]) 97 | 98 | [[:section {:title "Cursors"}]] 99 | 100 | "It is not very useful just selecting top-level forms. We need a way to move between the sections. This is where cursors come into picture. We can use `|` to set access to selected forms. For example, we can grab the entire top level form like this:" 101 | 102 | (fact 103 | ($ fragment [defn println]) 104 | => '[(defn hello [] (println "hello"))]) 105 | 106 | "But usually, the more common scenario is that we wish to perform a particular action on the `(println ...)` form. This is accessible by adding `\"|\"` in front of the `println` symbol:" 107 | 108 | (fact 109 | ($ fragment [defn | println]) 110 | => '[(println "hello")]) 111 | 112 | "We can see how the cursor works by drilling down into our code fragment:" 113 | 114 | (fact 115 | ($ fragment [defn if prn]) 116 | => '[(defn world [] (if true (prn "world")))] 117 | 118 | ($ fragment [| defn if prn]) 119 | => '[(defn world [] (if true (prn "world")))] 120 | 121 | ($ fragment [defn | if prn]) 122 | => '[(if true (prn "world"))] 123 | 124 | ($ fragment [defn if | prn]) 125 | => '[(prn "world")]) 126 | 127 | [[:section {:title "Fine Grain Control"}]] 128 | 129 | "It is not enough that we can walk to a particular form, we have to be able to control the place within the form that we wish to traverse to. " 130 | 131 | (fact 132 | ($ fragment [defn (if | _ & _)]) 133 | => '[true] 134 | 135 | ($ fragment [defn (if _ | _)]) 136 | => '[(prn "world")] 137 | 138 | ($ fragment [defn if (prn | _)]) 139 | => '["world"]) 140 | 141 | [[:section {:title "Pattern Matching"}]] 142 | 143 | "We can also use a pattern expressed using a list. Defining a pattern allows matched elements to be expressed more intuitively:" 144 | 145 | (fact 146 | 147 | ($ fragment [(defn & _)]) 148 | => '[(defn hello [] (println "hello")) 149 | (defn world [] (if true (prn "world")))] 150 | 151 | ($ fragment [(defn hello & _)]) 152 | => '[(defn hello [] (println "hello"))]) 153 | 154 | "A pattern can have nestings:" 155 | 156 | (fact 157 | ($ fragment [(defn world [] (if & _))]) 158 | => '[(defn world [] (if true (prn "world")))]) 159 | 160 | 161 | "If functions are needed, the symbols can be tagged with the a meta `^:%`" 162 | 163 | (fact 164 | ($ fragment [(defn world ^:% vector? ^:% list?)]) 165 | => '[(defn world [] (if true (prn "world")))]) 166 | 167 | "The queries are declarative and should be quite intuitive to use" 168 | 169 | (fact 170 | ($ fragment [(_ _ _ (if ^:% true? & _))]) 171 | => '[(defn world [] (if true (prn "world")))]) 172 | 173 | 174 | [[:section {:title "Insertion"}]] 175 | 176 | "We can additionally insert elements by tagging with the `^:+` meta:" 177 | 178 | (fact 179 | ($ fragment [(defn world _ ^:+ (prn "hello") & _)]) 180 | => '[(defn world [] (prn "hello") (if true (prn "world")))]) 181 | 182 | "There are some values that do not allow metas tags (`strings`, `keywords` and `number`), in this case 183 | the workaround is to use the `^:%+` meta and write the object as an expression to be evaluated. Note the writing `:%+` is the equivalent of writing `^{:% true :+ true}`" 184 | 185 | (fact 186 | ($ fragment [(defn world _ (if true (prn ^:%+ (keyword "hello") _)))]) 187 | => '[(defn world [] (if true (prn :hello "world")))]) 188 | 189 | "Insertions also work seamlessly with cursors:" 190 | 191 | (fact 192 | ($ fragment [(defn world _ (if true | (prn ^:%+ (long 2) _)))]) 193 | => '[(prn 2 "world")]) 194 | 195 | [[:section {:title "Deletion"}]] 196 | 197 | "We can delete values by using the `^:-` meta tag. When used on the code fragment, we can see that the function has been mangled as the first two elements have been deleted:" 198 | 199 | (fact 200 | ($ fragment [(defn ^:- world ^:- _ & _)]) 201 | => '[(defn (if true (prn "world")))]) 202 | 203 | "Entire forms can be marked for deletion:" 204 | 205 | (fact 206 | ($ fragment [(defn world _ ^:- (if & _))]) 207 | => '[(defn world [])]) 208 | 209 | "Deletions and insertions work quite well together. For example, below shows the replacement of the function name from `world` to `world2`:" 210 | 211 | (fact 212 | ($ fragment [(defn ^:- world _ ^:+ world2 & _)]) 213 | => '[(defn [] world2 (if true (prn "world")))]) 214 | 215 | [[:section {:title "Optional Matches"}]] 216 | 217 | "There are certain use cases when source code has optional parameters such as a docstring or a meta map." 218 | 219 | (fact 220 | ($ fragment [(defn ^:% symbol? ^:%?- string? ^:%?- map? ^:% vector? & _)]) 221 | => '[(defn hello [] (println "hello")) 222 | (defn world [] (if true (prn "world")))]) 223 | 224 | "We can use optional matches to clean up certain elements within the form, such as being able to remove docstrings and meta maps if they exist." 225 | 226 | (fact 227 | ($ {:string "(defn add \"adding numbers\" {:added \"0.1\"} [x y] (+ x y))"} 228 | [(defn ^:% symbol? ^:%?- string? ^:%?- map? ^:% vector? & _)] 229 | {:return :string}) 230 | => ["(defn add [x y] (+ x y))"]) 231 | 232 | 233 | [[:chapter {:title "Utilities"}]] 234 | 235 | "These utilities are specially designed to work with `rewrite-clj`;" 236 | 237 | (comment 238 | (use rewrite-clj.zip :as z)) 239 | 240 | [[:section {:title "traverse"}]] 241 | 242 | "While the `$` macro is provided for global searches within a file, `traverse` is provided to work with the zipper library for traversal/manipulation of a form." 243 | 244 | (fact 245 | (-> (z/of-string "(defn add \"adding numbers\" {:added \"0.1\"} [x y] (+ x y))") 246 | (traverse '(defn ^:% symbol? ^:%?- string? ^:%?- map? ^:% vector? | & _)) 247 | (z/insert-left '(prn "add")) 248 | (z/up) 249 | (z/sexpr)) 250 | => '(defn add [x y] (prn "add") (+ x y))) 251 | 252 | "`traverse` can also be given a function as the third argument. This will perform some action on the location given by the cursor and then jump out again:" 253 | 254 | (fact 255 | (-> (z/of-string "(defn add \"adding numbers\" {:added \"0.1\"} [x y] (+ x y))") 256 | (traverse '(defn ^:% symbol? ^:%?- string? ^:%?- map? ^:% vector? | & _) 257 | (fn [zloc] (z/insert-left zloc '(prn "add")))) 258 | (z/sexpr)) 259 | => '(defn add [x y] (prn "add") (+ x y))) 260 | 261 | "`traverse` works with metas as well, which is harder to work with using just `rewrite-clj`" 262 | 263 | (fact 264 | (-> (z/of-string "(defn add [x y] ^{:text 0} (+ (+ x 1) y 1))") 265 | (traverse '(defn _ _ (+ (+ | x 1) y 1)) 266 | (fn [zloc] (z/insert-left zloc '(prn "add")))) 267 | (z/sexpr)) 268 | => '(defn add [x y] (+ (+ (prn "add") x 1) y 1))) 269 | 270 | [[:section {:title "match"}]] 271 | 272 | "a map-based syntax is provided for matching:" 273 | 274 | (fact 275 | 276 | (-> (z/of-string "(if true (+ 1 2) (+ 1 1))") 277 | (match 'if)) 278 | => true 279 | 280 | (-> (z/of-string "(if true (+ 1 2) (+ 1 1))") 281 | (match {:form 'if})) 282 | => true 283 | 284 | (-> (z/of-string "(if true (+ 1 2) (+ 1 1))") 285 | (match {:is list?})) 286 | => true 287 | 288 | (-> (z/of-string "(if true (+ 1 2) (+ 1 1))") 289 | (match {:child {:is true}})) 290 | => true 291 | 292 | (-> (z/of-string "(if true (+ 1 2) (+ 1 1))") 293 | (match {:child {:form '+}})) 294 | => true) 295 | 296 | "there are many options for matches: 297 | 298 | - `:fn` match on checking function 299 | - `:is` match on value or checking function 300 | - `:or` match two options, done using a set 301 | - `:equal` match on equivalence 302 | - `:type` match on `rewrite-clj` type 303 | - `:meta` match on meta tag 304 | - `:form` match on first element of a form 305 | - `:pattern` match on a pattern 306 | - `:code` match on code 307 | 308 | - `:parent` match on direct parent of element 309 | - `:child` match on any child of element 310 | - `:first` match on first child of element 311 | - `:last` match on last child of element 312 | - `:nth` match on nth child of element 313 | - `:nth-left` match on nth-sibling to the left of element 314 | - `:nth-right` match on nth-sibling to the right of element 315 | - `:nth-ancestor` match on the ancestor that is n levels higher 316 | - `:nth-contains` match on any contained element that is n levels lower 317 | - `:ancestor` match on any ancestor 318 | - `:contains` match on any contained element 319 | - `:sibling` match on any sibling 320 | - `:left` match on node directly to left 321 | - `:right` match on node directly to right 322 | - `:left-of` match on node to left 323 | - `:right-of` match on node to right 324 | - `:left-most` match is element is the left-most element 325 | - `:right-most` match is element is the right-most element" 326 | 327 | [[:subsection {:title ":fn"}]] 328 | 329 | "The most general match, takes a predicate dispatching on a zipper location" 330 | 331 | (fact 332 | (-> (z/of-string "(if true (+ 1 2) (+ 1 1))") 333 | (match {:fn (fn [zloc] (= :list (z/tag zloc)))})) 334 | => true) 335 | 336 | [[:subsection {:title ":is"}]] 337 | 338 | "The most general match, takes a value or a function" 339 | 340 | (fact 341 | (-> (z/of-string "(if true (+ 1 2) (+ 1 1))") 342 | (match {:child {:is true}})) 343 | => true 344 | 345 | (fact 346 | (-> (z/of-string "(if true (+ 1 2) (+ 1 1))") 347 | (match {:child {:is (fn [x] (instance? Boolean x))}})) 348 | => true)) 349 | 350 | [[:subsection {:title ":form"}]] 351 | 352 | "By default, a symbol is evaluated as a `:form`'" 353 | 354 | (fact 355 | (-> (z/of-string "(if true (+ 1 2) (+ 1 1))") 356 | (match 'if)) 357 | => true) 358 | 359 | "It can also be expressed explicitly:" 360 | 361 | (fact 362 | (-> (z/of-string "(if true (+ 1 2) (+ 1 1))") 363 | (match '{:form if})) 364 | => true) 365 | 366 | [[:subsection {:title ":or"}]] 367 | 368 | "or style matching done using set notation" 369 | 370 | (fact 371 | (-> (z/of-string "(if true (+ 1 2) (+ 1 1))") 372 | (match '#{{:form if} {:form defn}})) 373 | => true) 374 | 375 | (fact 376 | (-> (z/of-string "(if true (+ 1 2) (+ 1 1))") 377 | (match '#{if defn})) 378 | => true) 379 | 380 | "if need arises to match a set, use the `^&` meta tag" 381 | 382 | (fact 383 | (-> (z/of-string "(if #{:a :b :c} (+ 1 2) (+ 1 1))") 384 | (match {:child {:is '^& #{:a :b :c}}})) 385 | => true) 386 | 387 | [[:subsection {:title ":and"}]] 388 | 389 | "similar usage to :or except that vector notation is used:" 390 | 391 | (fact 392 | (-> (z/of-string "(if true (+ 1 2) (+ 1 1))") 393 | (match '[if defn])) 394 | => false 395 | 396 | (-> (z/of-string "(if true (+ 1 2) (+ 1 1))") 397 | (match '[if {:contains 1}])) 398 | => true) 399 | 400 | [[:subsection {:title ":equal"}]] 401 | 402 | "matches sets, vectors and maps as is" 403 | 404 | (fact 405 | (-> (z/of-string "(if #{:a :b :c} (+ 1 2) (+ 1 1))") 406 | (match {:child {:equal #{:a :b :c}}})) 407 | => true 408 | 409 | (-> (z/of-string "(if {:a 1 :b 2} (+ 1 2) (+ 1 1))") 410 | (match {:child {:equal {:a 1 :b 2}}})) 411 | => true) 412 | 413 | [[:subsection {:title ":type"}]] 414 | 415 | "predicate on the rewrite-clj reader type" 416 | 417 | (fact 418 | (-> (z/of-string "(if true (+ 1 2) (+ 1 1))") 419 | (match {:type :list})) 420 | => true 421 | 422 | (-> (z/of-string "(if true (+ 1 2) (+ 1 1))") 423 | (match {:child {:type :token}})) 424 | => true) 425 | 426 | [[:subsection {:title ":meta"}]] 427 | 428 | "matches the meta on a location" 429 | 430 | (fact 431 | (-> (z/down (z/of-string "^:a (+ 1 1)")) 432 | (match {:meta :a})) 433 | => true 434 | 435 | (-> (z/down (z/of-string "^{:a true} (+ 1 1)")) 436 | (match {:meta {:a true}})) 437 | => true) 438 | 439 | [[:subsection {:title ":pattern"}]] 440 | 441 | "pattern matches are done automatically with a list" 442 | 443 | (fact 444 | (-> (z/of-string "(if true (+ 1 2) (+ 1 1))") 445 | (match '(if true & _))) 446 | => true) 447 | 448 | "but they can be made more explicit:" 449 | 450 | (fact 451 | (-> (z/of-string "(if true (+ 1 2) (+ 1 1))") 452 | (match {:pattern '(if true & _)})) 453 | => true) 454 | 455 | [[:subsection {:title ":parent"}]] 456 | 457 | "matches on the parent form" 458 | 459 | (fact 460 | (-> (z/of-string "(if true (+ 1 2) (+ 1 1))") 461 | (z/down) 462 | (z/right) 463 | (match {:parent 'if})) 464 | => true) 465 | 466 | 467 | [[:subsection {:title ":child"}]] 468 | 469 | "matches on any of the child forms" 470 | 471 | (fact 472 | (-> (z/of-string "(if true (+ 1 2) (+ 1 1))") 473 | (match {:child '(+ _ 2)})) 474 | => true) 475 | 476 | [[:subsection {:title ":first"}]] 477 | 478 | "matches on the first child, can also be a vector" 479 | 480 | (fact 481 | (-> (z/of-string "(if [1 2 3] (+ 1 2) (+ 1 1))") 482 | (match {:child {:first '+}})) 483 | => true 484 | 485 | (-> (z/of-string "(if [1 2 3] (+ 1 2) (+ 1 1))") 486 | (match {:child {:first 1}})) 487 | => true) 488 | 489 | [[:subsection {:title ":last"}]] 490 | 491 | "matches on the last child element" 492 | 493 | (fact 494 | (-> (z/of-string "(if [1 2 3] (+ 1 2) (+ 1 1))") 495 | (match {:child {:last 3}})) 496 | => true 497 | 498 | (-> (z/of-string "(if [1 2 3] (+ 1 2) (+ 1 1))") 499 | (match {:child {:last 1}})) 500 | => true) 501 | 502 | [[:subsection {:title ":nth"}]] 503 | 504 | "matches the nth child" 505 | 506 | (fact 507 | (-> (z/of-string "(if [1 2 3] (+ 1 2) (+ 1 1))") 508 | (match {:nth [1 {:equal [1 2 3]}]})) 509 | => true) 510 | 511 | [[:subsection {:title ":nth-left"}]] 512 | 513 | "matches the nth sibling to the left" 514 | 515 | (fact 516 | (-> (z/of-string "(if [1 2 3] (+ 1 2) (+ 1 1))") 517 | (z/down) 518 | (z/rightmost) 519 | (match {:nth-left [2 {:equal [1 2 3]}]})) 520 | => true) 521 | 522 | 523 | [[:subsection {:title ":nth-right"}]] 524 | 525 | "matches the nth sibling to the right" 526 | 527 | (fact 528 | (-> (z/of-string "(if [1 2 3] (+ 1 2) (+ 1 1))") 529 | (z/down) 530 | (match {:nth-right [1 {:equal [1 2 3]}]})) 531 | => true) 532 | 533 | [[:subsection {:title ":nth-ancestor"}]] 534 | 535 | "matches the nth ancestor in the hierarchy" 536 | 537 | (fact 538 | (-> (z/of-string "(if [1 2 3] (+ 1 2) (+ 1 1))") 539 | (z/down) 540 | (z/right) 541 | (z/down) 542 | (match {:nth-ancestor [2 {:form 'if}]})) 543 | => true) 544 | 545 | [[:subsection {:title ":nth-contains"}]] 546 | 547 | "matches the nth level children" 548 | 549 | (fact 550 | (-> (z/of-string "(if [1 2 3] (+ 1 2) (+ 1 1))") 551 | (match {:nth-contains [2 {:is 3}]})) 552 | => true) 553 | 554 | [[:subsection {:title ":ancestor"}]] 555 | 556 | "matches any ancestor" 557 | 558 | (fact 559 | (-> (z/of-string "(if [1 2 3] (+ 1 2) (+ 1 1))") 560 | (z/down) 561 | (z/right) 562 | (z/down) 563 | (match {:ancestor 'if})) 564 | => true) 565 | 566 | [[:subsection {:title ":contains"}]] 567 | 568 | "matches the any subelement contained by the element" 569 | 570 | (fact 571 | (-> (z/of-string "(if [1 2 3] (+ 1 2) (+ 1 1))") 572 | (match {:contains 3})) 573 | => true) 574 | 575 | [[:subsection {:title ":sibling"}]] 576 | 577 | "matches any sibling" 578 | 579 | (fact 580 | (-> (z/of-string "(if [1 2 3] (+ 1 2) (+ 1 1))") 581 | (z/down) 582 | (match {:sibling {:form '+}})) 583 | => true) 584 | 585 | [[:subsection {:title ":left"}]] 586 | 587 | "matches element to the left" 588 | 589 | (fact 590 | (-> (z/of-string "(if [1 2 3] (+ 1 2) (+ 1 1))") 591 | (z/down) 592 | (z/right) 593 | (match {:left {:is 'if}})) 594 | => true) 595 | 596 | [[:subsection {:title ":right"}]] 597 | 598 | "matches element to the right" 599 | 600 | (fact 601 | (-> (z/of-string "(if [1 2 3] (+ 1 2) (+ 1 1))") 602 | (z/down) 603 | (match {:right {:is [1 2 3]}})) 604 | => true) 605 | 606 | [[:subsection {:title ":left-of"}]] 607 | 608 | "matches any element to the left" 609 | 610 | (fact 611 | (-> (z/of-string "(if [1 2 3] (+ 1 2) (+ 1 1))") 612 | (z/down) 613 | (z/rightmost) 614 | (match {:left-of {:is [1 2 3]}})) 615 | => true) 616 | 617 | [[:subsection {:title ":right-of"}]] 618 | 619 | "matches any element to the right" 620 | 621 | (fact 622 | (-> (z/of-string "(if [1 2 3] (+ 1 2) (+ 1 1))") 623 | (z/down) 624 | (match {:right-of '(+ 1 1)})) 625 | => true) 626 | 627 | [[:subsection {:title ":left-most"}]] 628 | 629 | "is the left-most element" 630 | 631 | (fact 632 | (-> (z/of-string "(if [1 2 3] (+ 1 2) (+ 1 1))") 633 | (z/down) 634 | (match {:left-most true})) 635 | => true) 636 | 637 | [[:subsection {:title ":right-most"}]] 638 | 639 | "is the right-most element" 640 | 641 | (fact 642 | (-> (z/of-string "(if [1 2 3] (+ 1 2) (+ 1 1))") 643 | (z/down) 644 | (z/rightmost) 645 | (match {:right-most true})) 646 | => true) 647 | --------------------------------------------------------------------------------