├── .circleci └── config.yml ├── .github └── CODEOWNERS ├── .gitignore ├── CHANGES.md ├── LICENSE ├── ORIGINATOR ├── README.md ├── package-lock.json ├── package.json ├── project.clj ├── rewrite-clj-licence ├── src └── rewrite_clj │ ├── node.cljs │ ├── node │ ├── coercer.cljs │ ├── comment.cljs │ ├── fn.cljs │ ├── forms.cljs │ ├── keyword.cljs │ ├── meta.cljs │ ├── protocols.cljs │ ├── quote.cljs │ ├── reader_macro.cljs │ ├── seq.cljs │ ├── stringz.cljs │ ├── token.cljs │ ├── uneval.cljs │ └── whitespace.cljs │ ├── paredit.cljs │ ├── parser.cljs │ ├── parser │ ├── core.cljs │ ├── keyword.cljs │ ├── string.cljs │ ├── token.cljs │ └── whitespace.cljs │ ├── reader.cljs │ ├── zip.cljs │ └── zip │ ├── base.cljs │ ├── editz.cljs │ ├── findz.cljs │ ├── insert.cljs │ ├── move.cljs │ ├── removez.cljs │ ├── seqz.cljs │ ├── utils.cljs │ └── whitespace.cljs └── test └── rewrite_clj ├── node_test.cljs ├── paredit_test.cljs ├── runner.cljs ├── zip ├── editz_test.cljs ├── findz_test.cljs └── seqz_test.cljs └── zip_test.cljs /.circleci/config.yml: -------------------------------------------------------------------------------- 1 | # Clojure CircleCI 2.0 configuration file 2 | # 3 | # Check https://circleci.com/docs/2.0/language-clojure/ for more details 4 | # 5 | version: 2 6 | jobs: 7 | build: 8 | docker: 9 | - image: circleci/clojure:lein-2.9.1-node-browsers 10 | 11 | working_directory: ~/repo 12 | 13 | environment: 14 | LEIN_ROOT: "true" 15 | # Customize the JVM maximum heap limit 16 | JVM_OPTS: -Xmx3200m 17 | 18 | steps: 19 | - checkout 20 | 21 | # Download and cache dependencies 22 | - restore_cache: 23 | keys: 24 | - v1-dependencies-{{ checksum "project.clj" }} 25 | # fallback to using the latest cache if no exact match is found 26 | - v1-dependencies- 27 | 28 | - run: sudo npm install karma-cli -g 29 | - run: npm install 30 | - run: lein deps 31 | 32 | - save_cache: 33 | paths: 34 | - ~/.m2 35 | key: v1-dependencies-{{ checksum "project.clj" }} 36 | 37 | - run: lein doo chrome-headless test once 38 | 39 | - store_test_results: 40 | path: target/out/test-results 41 | 42 | - store_artifacts: 43 | path: target/out/test-results 44 | -------------------------------------------------------------------------------- /.github/CODEOWNERS: -------------------------------------------------------------------------------- 1 | * @rundis @lread 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | /doc 6 | /node_modules 7 | pom.xml 8 | pom.xml.asc 9 | *.jar 10 | *.class 11 | .lein-deps-sum 12 | .lein-failures 13 | .lein-plugins 14 | .lein-repl-history 15 | *.swp 16 | *~ 17 | .nrepl-port 18 | .idea/ 19 | *.iml -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## Changelog 2 | 3 | ### 0.4.5 4 | - freshen project - update deps, fix test runner, setup for CircleCI 5 | 6 | ### 0.4.4 7 | - refactor: Upgrade tools.reader to 1.0.5 and fix broken call to read-token 8 | - fix: rewrite-clj.node/length 9 | - fix: in-range? 10 | 11 | ### 0.4.3 12 | - Handle multiline regex 13 | 14 | ### 0.4.2 15 | - Support reader conditionals 16 | 17 | ### 0.4.1 18 | - Fixed handling of global flags for regex getting lost when parsing (or rather when stringifiying them back) 19 | - Clean up compiler warnings 20 | 21 | ### 0.4.0 22 | - Upped Clojure to 1.7.0 and ClojureScript 1.7.228 23 | - Using cljs.tools.reader rather than a custom reader 24 | - Tests are run using https://github.com/bensu/doo 25 | 26 | Kudos to https://github.com/mhuebert for the awesome pull request ! 27 | 28 | ### 0.3.1 29 | - Significant improvement in performance of parsing 30 | 31 | ### 0.3.0 32 | - Performance improvements 33 | 34 | ### 0.2.0 35 | - Kill one (ParEdit) 36 | - Raise (ParEdit) 37 | - Fixed bug with namespaced keywords 38 | - Fixed bug with coercion of function nodes 39 | 40 | ### 0.1.0 41 | - Initial release 42 | - Port initiated from version 0.4.12 of rewrite-clj. Check out it's https://github.com/xsc/rewrite-clj/blob/master/CHANGES.md[changelog]. 43 | Not all functions have been ported (most notably zip subedit support and printing of nodes are missing) 44 | - Also added a paredit namespace for common pareedit features that modifies the source (slurp, barf, kill, join, split etc) 45 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2015 Magnus Rundberget 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /ORIGINATOR: -------------------------------------------------------------------------------- 1 | @rundis 2 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## rewrite-cljs 2 | 3 | ### :stop_sign: for your consideration: 4 | The functionality of rewrite-cljs (and much more) has been incorporated into [rewrite-clj v1](https://github.com/clj-commons/rewrite-clj).
5 | All further work on the ClojureScript version of rewrite-clj will continue in the rewrite-clj project.
6 | No further work is currently planned for this project. 7 | 8 | [![Clojars Project](https://img.shields.io/clojars/v/rewrite-cljs.svg)](https://clojars.org/rewrite-cljs) 9 | [![cljdoc badge](https://cljdoc.org/badge/rewrite-cljs)](https://cljdoc.org/d/rewrite-cljs) 10 | [![CircleCI](https://circleci.com/gh/clj-commons/rewrite-cljs.svg?style=svg)](https://circleci.com/gh/clj-commons/rewrite-cljs) 11 | 12 | This library is a ClojureScript port of [rewrite-clj](https://github.com/xsc/rewrite-clj). 13 | It provides features to traverse and rewrite Clojure/ClojureScript/EDN documents in a whitespace and comment-aware manner replicating 14 | the behavior of its Clojure counterpart as closely as possible. 15 | 16 | > :wave: Want to chat? Say hi on [Clojurians Slack](http://clojurians.net/) in [#rewrite-clj](https://clojurians.slack.com/messages/CHB5Q2XUJ). 17 | 18 | Created by @rundis in 2015, rewrite-cljs was originally used for Clojure/ClojureScript refactoring support in [Light Table](https://github.com/LightTable/LightTable). In January of 2019, @rundis graciously transferred rewrite-cljs to clj-commons. 19 | 20 | rewrite-cljs includes: 21 | - An EDN parser 22 | - An EDN aware zipper (using clojure.zip for ClojureScript) 23 | - A customized cljs.reader (based on [clojurescript-in-clojurescript](https://github.com/kanaka/clojurescript/blob/cljs_in_cljs/src/cljs/cljs/reader.cljs) that mimics more of clojure.tools.reader 24 | 25 | 26 | 27 | ## Quick start 28 | Here's a little teaser on the sort of things you can do with the zipper features. 29 | 30 | ```clojure 31 | (ns rewrite-clj.zip-test 32 | (:require-macros [cemerick.cljs.test :refer (is deftest )]) 33 | (:require [cemerick.cljs.test :as t] 34 | [rewrite-clj.zip :as z] 35 | [rewrite-clj.node :as n])) 36 | 37 | (deftest manipulate-sexpr 38 | (let [sexpr " 39 | ^{:dynamic true} (+ 1 1 40 | (+ 2 2) 41 | (reduce + [1 3 4]))" 42 | expected " 43 | ^{:dynamic true} (+ 1 1 44 | (+ 2 2) 45 | (reduce + [6 7 [1 2]]))"] 46 | (is (= expected (-> sexpr 47 | z/of-string 48 | (z/find-tag-by-pos {:row 4 :col 19} :vector) 49 | (z/replace [5 6 7]) 50 | (z/append-child [1 2]) 51 | z/down 52 | z/remove 53 | z/root-string))))) 54 | ``` 55 | 56 | ## Limitations and ommissions 57 | 58 | - rewrite-cljs has fallen quite far behind rewrite-clj - with some love from the community, we can bring it up to date. 59 | - There is no support for parsing files (duh) 60 | - cljs.extended.reader which is used for reading edn/clojure/clojurescript, has lot of limitations. Please don't be surprised 61 | when encountering errors during reading of perhaps legal but hopefully infrequently used language constructs. 62 | - Some features in rewrite-clj are heavily based on macros, these features have been omitted for now 63 | - Nice printing of nodes - Not implemented 64 | - [zip subedit support](https://github.com/xsc/rewrite-clj/blob/master/src/rewrite_clj/zip/subedit.clj) is not implemented (YET!) 65 | - The reader captures positional metadata {:row :col :end-row :end-col} for all nodes. As long as you are only traversing the nodes you should be fine using the meta data and functions that depend on them (example zip/find-last-by-pos). However if you perform any form of rewriting the meta-data can't be trusted any longer. Not sure how to address that tbh. Pull requests are more than welcome! 66 | 67 | ## Rationale 68 | Why a separate project? Why not incorporate ClojureScript support directly into rewrite-clj? 69 | 70 | This might have not been terribly viable when this project was first created, but certainly is an option to consider today. 71 | 72 | ## Licenses 73 | 74 | ### License for rewrite-cljs 75 | ``` 76 | The MIT License (MIT) 77 | 78 | Copyright (c) 2015 Magnus Rundberget 79 | 80 | Permission is hereby granted, free of charge, to any person obtaining a copy 81 | of this software and associated documentation files (the "Software"), to deal 82 | in the Software without restriction, including without limitation the rights 83 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 84 | copies of the Software, and to permit persons to whom the Software is 85 | furnished to do so, subject to the following conditions: 86 | 87 | The above copyright notice and this permission notice shall be included in all 88 | copies or substantial portions of the Software. 89 | 90 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 91 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 92 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 93 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 94 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 95 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 96 | SOFTWARE. 97 | ``` 98 | 99 | ### License for rewrite-clj 100 | ``` 101 | The MIT License (MIT) 102 | 103 | Copyright (c) 2013-2015 Yannick Scherer 104 | 105 | Permission is hereby granted, free of charge, to any person obtaining a copy 106 | of this software and associated documentation files (the "Software"), to deal 107 | in the Software without restriction, including without limitation the rights 108 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 109 | copies of the Software, and to permit persons to whom the Software is 110 | furnished to do so, subject to the following conditions: 111 | 112 | The above copyright notice and this permission notice shall be included in all 113 | copies or substantial portions of the Software. 114 | 115 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 116 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 117 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 118 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 119 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 120 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 121 | SOFTWARE. 122 | ``` 123 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "devDependencies": { 3 | "karma": "^4.0.1", 4 | "karma-chrome-launcher": "^2.2.0", 5 | "karma-cljs-test": "^0.1.0", 6 | "karma-junit-reporter": "^1.2.0" 7 | } 8 | } 9 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject rewrite-cljs "0.4.6-SNAPSHOT" 2 | :description "Comment-/Whitespace-preserving rewriting of EDN documents." 3 | :url "https://github.com/clj-commons/rewrite-cljs" 4 | :license {:name "MIT License" 5 | :url "http://opensource.org/licenses/MIT" 6 | :year 2015 7 | :key "mit"} 8 | :dependencies [[org.clojure/clojure "1.10.0"] 9 | [org.clojure/clojurescript "1.10.520" 10 | :exclusions [org.apache.ant/ant]] 11 | [org.clojure/tools.reader "1.3.2"]] 12 | 13 | :deploy-repositories [["clojars" {:url "https://clojars.org/repo" 14 | :username :env/clojars_user 15 | :password :env/clojars_pass 16 | :sign-releases false}]] 17 | 18 | :clean-targets ^{:protect false} [:target-path :compile-path "out"] 19 | 20 | :doo {:build "test" 21 | :karma {:config {"plugins" ["karma-junit-reporter"] 22 | "reporters" ["progress" "junit"] 23 | "junitReporter" {"outputDir" "target/out/test-results"}}}} 24 | 25 | :profiles {:dev 26 | {:plugins [[lein-cljsbuild "1.1.7"] 27 | [lein-doo "0.1.11"]] 28 | 29 | :cljsbuild {:builds 30 | [{:id "test" 31 | :source-paths ["test"] 32 | :compiler {:output-dir "target/cljsbuild/test/out" 33 | :output-to "target/cljsbuild/test/main.js" 34 | :main rewrite-clj.runner 35 | :optimizations :none 36 | :pretty-print true}}]}} 37 | 38 | :doc {:plugins [[funcool/codeina "0.1.0" 39 | :exclusions [org.clojure/clojure]]] 40 | :codeina {:sources ["src"] 41 | :language :clojurescript 42 | :src-dir-uri "https://github.com/clj-commons/rewrite-cljs/blob/master/" 43 | :src-linenum-anchor-prefix "L"}}} 44 | 45 | :aliases {"auto-test" ["with-profile" "dev" "do" "clean," "cljsbuild" "auto" "test"]}) 46 | -------------------------------------------------------------------------------- /rewrite-clj-licence: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2013-2015 Yannick Scherer 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /src/rewrite_clj/node.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.node 2 | "Facade for node related namespaces." 3 | (:require [rewrite-clj.node.coercer] 4 | [rewrite-clj.node.protocols :as prot] 5 | [rewrite-clj.node.keyword :as kw-node] 6 | [rewrite-clj.node.seq :as seq-node] 7 | [rewrite-clj.node.whitespace :as ws-node] 8 | [rewrite-clj.node.token :as tok-node] 9 | [rewrite-clj.node.comment :as cmt-node] 10 | [rewrite-clj.node.forms :as fm-node] 11 | [rewrite-clj.node.meta :as mt-node] 12 | [rewrite-clj.node.stringz :as s-node] 13 | [rewrite-clj.node.reader-macro :as rm-node] 14 | [rewrite-clj.node.quote :as q-node] 15 | [rewrite-clj.node.uneval :as ue-node] 16 | [rewrite-clj.node.fn :as f-node])) 17 | 18 | 19 | 20 | 21 | 22 | ; ******************************* 23 | ; see rewrite-clj.node.protocols 24 | ; ******************************* 25 | (def tag 26 | "See [[protocols/tag]]" 27 | prot/tag) 28 | (def sexpr 29 | "See [[protocols/sexpr]]" 30 | prot/sexpr) 31 | (def string 32 | "See [[protocols/string]]" 33 | prot/string) 34 | (def children 35 | "See [[protocols/children]]" 36 | prot/children) 37 | (def child-sexprs 38 | "See [[protocols/sexprs]]" 39 | prot/child-sexprs) 40 | (def replace-children 41 | "See [[protocols/replace-children]]" 42 | prot/replace-children) 43 | (def inner? 44 | "See [[protocols/inner?]]" 45 | prot/inner?) 46 | (def printable-only? 47 | "See [[protocols/printable-only?]]" 48 | prot/printable-only?) 49 | (def coerce 50 | "See [[protocols/coerce]]" 51 | prot/coerce) 52 | (def length 53 | "See [[protocols/length]]" 54 | prot/length) 55 | 56 | 57 | ; ******************************* 58 | ; see rewrite-clj.node.forms 59 | ; ******************************* 60 | (def forms-node 61 | "see [[forms/forms-node]]" 62 | fm-node/forms-node) 63 | (def keyword-node 64 | "see [[keyword/keyword-node]]" 65 | kw-node/keyword-node) 66 | 67 | 68 | ; ******************************* 69 | ; see rewrite-clj.node.seq 70 | ; ******************************* 71 | (def list-node 72 | "See [[seq/list-node]]" 73 | seq-node/list-node) 74 | (def vector-node 75 | "See [[seq/vector-node]]" 76 | seq-node/vector-node) 77 | (def set-node 78 | "See [[seq/set-node]]" 79 | seq-node/set-node) 80 | (def map-node 81 | "See [[seq/map-node]]" 82 | seq-node/map-node) 83 | 84 | 85 | ; ******************************* 86 | ; see rewrite-clj.node.string 87 | ; ******************************* 88 | (def string-node 89 | "See [[stringz/string-node]]" 90 | s-node/string-node) 91 | 92 | 93 | 94 | ; ******************************* 95 | ; see rewrite-clj.node.comment 96 | ; ******************************* 97 | (def comment-node 98 | "See [[comment/comment-node]]" 99 | cmt-node/comment-node) 100 | (def comment? 101 | "See [[comment/comment?]]" 102 | cmt-node/comment?) 103 | 104 | 105 | 106 | ; ******************************* 107 | ; see rewrite-clj.node.whitespace 108 | ; ******************************* 109 | (def whitespace-node 110 | "See [[whitespace/whitespace-node]]" 111 | ws-node/whitespace-node) 112 | (def newline-node 113 | "See [[whitespace/newline-node]]" 114 | ws-node/newline-node) 115 | (def spaces 116 | "See [[whitespace/spaces]]" 117 | ws-node/spaces) 118 | (def newlines 119 | "See [[whitespace/newlines]]" 120 | ws-node/newlines) 121 | (def whitespace? 122 | "See [[whitespace/whitespace?]]" 123 | ws-node/whitespace?) 124 | (def linebreak? 125 | "See [[whitespace/linebreak?]]" 126 | ws-node/linebreak?) 127 | 128 | (defn whitespace-or-comment? 129 | "Check whether the given node represents whitespace or comment." 130 | [node] 131 | (or (whitespace? node) 132 | (comment? node))) 133 | 134 | 135 | ; ******************************* 136 | ; see rewrite-clj.node.token 137 | ; ******************************* 138 | (def token-node 139 | "See [[token/token-node]]" 140 | tok-node/token-node) 141 | 142 | 143 | ; ******************************* 144 | ; see rewrite-clj.node.reader-macro 145 | ; ******************************* 146 | (def var-node 147 | "See [[reader-macro/var-node]]" 148 | rm-node/var-node) 149 | (def eval-node 150 | "See [[reader-macro/eval-node]]" 151 | rm-node/eval-node) 152 | (def reader-macro-node 153 | "See [[reader-macro/reader-macro-node]]" 154 | rm-node/reader-macro-node) 155 | (def deref-node 156 | "See [[reader-macro/deref-node]]" 157 | rm-node/deref-node) 158 | 159 | 160 | ; ******************************* 161 | ; see rewrite-clj.node.quote 162 | ; ******************************* 163 | (def quote-node 164 | "See [[quote/quote-node]]" 165 | q-node/quote-node) 166 | (def syntax-quote-node 167 | "See [[quote/syntax-quote-node]]" 168 | q-node/syntax-quote-node) 169 | (def unquote-node 170 | "See [[quote/unquote-node]]" 171 | q-node/unquote-node) 172 | (def unquote-splicing-node 173 | "See [[quote/unquote-splicing-node]]" 174 | q-node/unquote-splicing-node) 175 | 176 | 177 | ; ******************************* 178 | ; see rewrite-clj.node.uneval 179 | ; ******************************* 180 | (def uneval-node 181 | "See [[uneval/uneval-node]]" 182 | ue-node/uneval-node) 183 | 184 | 185 | ; ******************************* 186 | ; see rewrite-clj.node.meta 187 | ; ******************************* 188 | (def meta-node 189 | "See [[meta/meta-node]]" 190 | mt-node/meta-node) 191 | 192 | ; ******************************* 193 | ; see rewrite-clj.node.fn 194 | ; ******************************* 195 | (def fn-node 196 | "See [[fn/fn-node]]" 197 | f-node/fn-node) 198 | -------------------------------------------------------------------------------- /src/rewrite_clj/node/coercer.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.node.coercer 2 | (:require [rewrite-clj.node.comment :refer [CommentNode]] 3 | [rewrite-clj.node.forms :refer [FormsNode]] 4 | [rewrite-clj.node.keyword :refer [KeywordNode]] 5 | [rewrite-clj.node.quote :refer [QuoteNode]] 6 | [rewrite-clj.node.stringz :refer [StringNode string-node]] 7 | [rewrite-clj.node.uneval :refer [UnevalNode]] 8 | [rewrite-clj.node.meta :refer [MetaNode meta-node]] 9 | [rewrite-clj.node.fn :refer [FnNode]] 10 | [rewrite-clj.node.protocols :refer [NodeCoerceable coerce]] 11 | [rewrite-clj.node.reader-macro :refer [ReaderNode ReaderMacroNode DerefNode]] 12 | [rewrite-clj.node.seq :refer [SeqNode vector-node list-node set-node map-node]] 13 | [rewrite-clj.node.token :refer [TokenNode token-node]] 14 | [rewrite-clj.node.whitespace :refer [WhitespaceNode NewlineNode whitespace-node space-separated]])) 15 | 16 | ;; ## Helpers 17 | 18 | (defn node-with-meta 19 | [n value] 20 | (if (implements? IWithMeta value) 21 | (let [mta (meta value)] 22 | (if (empty? mta) 23 | n 24 | (meta-node (coerce mta) n))) 25 | n)) 26 | 27 | 28 | ;; ## Tokens 29 | 30 | (extend-protocol NodeCoerceable 31 | object 32 | (coerce [v] 33 | (node-with-meta 34 | (token-node v) 35 | v))) 36 | 37 | ;; Number 38 | (extend-protocol NodeCoerceable 39 | number 40 | (coerce [n] 41 | (node-with-meta 42 | (token-node n) 43 | n))) 44 | 45 | ;; Number 46 | (extend-protocol NodeCoerceable 47 | string 48 | (coerce [n] 49 | (node-with-meta 50 | (string-node n) 51 | n))) 52 | 53 | 54 | 55 | ;; ## Seqs 56 | 57 | (defn seq-node 58 | [f sq] 59 | (node-with-meta 60 | (->> (map coerce sq) 61 | (space-separated) 62 | (vec) 63 | (f)) 64 | sq)) 65 | 66 | (extend-protocol NodeCoerceable 67 | PersistentVector 68 | (coerce [sq] 69 | (seq-node vector-node sq)) 70 | List 71 | (coerce [sq] 72 | (seq-node list-node sq)) 73 | PersistentHashSet 74 | (coerce [sq] 75 | (seq-node set-node sq))) 76 | 77 | 78 | 79 | 80 | ;; ## Maps 81 | 82 | (let [comma (whitespace-node ", ") 83 | space (whitespace-node " ")] 84 | (defn- map->children 85 | [m] 86 | (->> (mapcat 87 | (fn [[k v]] 88 | [(coerce k) space (coerce v) comma]) 89 | m) 90 | (butlast) 91 | (vec)))) 92 | 93 | 94 | (extend-protocol NodeCoerceable 95 | PersistentHashMap 96 | (coerce [m] 97 | (node-with-meta 98 | (map-node (map->children m)) 99 | m))) 100 | 101 | 102 | 103 | 104 | ;(seq-node vector-node [1]) 105 | 106 | ;; ## Vars 107 | 108 | ;; (extend-protocol NodeCoerceable 109 | ;; Var 110 | ;; (coerce [v] 111 | ;; (-> (str v) 112 | ;; (subs 2) 113 | ;; (symbol) 114 | ;; (token-node) 115 | ;; (vector) 116 | ;; (var-node)))) 117 | 118 | ;; ## Existing Nodes 119 | 120 | (extend-protocol NodeCoerceable 121 | CommentNode (coerce [v] v) 122 | FormsNode (coerce [v] v) 123 | FnNode (coerce [v] v) 124 | ;IntNode (coerce [v] v) 125 | KeywordNode (coerce [v] v) 126 | MetaNode (coerce [v] v) 127 | QuoteNode (coerce [v] v) 128 | ReaderNode (coerce [v] v) 129 | ReaderMacroNode (coerce [v] v) 130 | DerefNode (coerce [v] v) 131 | StringNode (coerce [v] v) 132 | ;UnevalNode (coerce [v] v) 133 | NewlineNode (coerce [v] v) 134 | SeqNode (coerce [v] v) 135 | TokenNode (coerce [v] v) 136 | WhitespaceNode (coerce [v] v)) 137 | -------------------------------------------------------------------------------- /src/rewrite_clj/node/comment.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.node.comment 2 | (:require [rewrite-clj.node.protocols :as node])) 3 | 4 | ;; ## Node 5 | 6 | (defrecord CommentNode [s] 7 | node/Node 8 | (tag [_] :comment) 9 | (printable-only? [_] true) 10 | (sexpr [_] 11 | (throw (js/Error. "Unsupported operation"))) 12 | (length [_] 13 | (+ 1 (count s))) 14 | (string [_] 15 | (str ";" s)) 16 | 17 | Object 18 | (toString [this] 19 | (node/string this))) 20 | 21 | ;;(node/make-printable! CommentNode) 22 | 23 | ;; ## Constructor 24 | 25 | (defn comment-node 26 | "Create node representing an EDN comment." 27 | [s] 28 | (->CommentNode s)) 29 | 30 | (defn comment? 31 | "Check whether a node represents a comment." 32 | [node] 33 | (= (node/tag node) :comment)) 34 | 35 | 36 | 37 | -------------------------------------------------------------------------------- /src/rewrite_clj/node/fn.cljs: -------------------------------------------------------------------------------- 1 | (ns ^:no-doc rewrite-clj.node.fn 2 | (:require [rewrite-clj.node.protocols :as node] 3 | [clojure.walk :as w])) 4 | 5 | ;; ## Conversion 6 | 7 | (defn- construct-fn 8 | "Construct function form." 9 | [syms vararg body] 10 | (list 11 | 'fn* 12 | (vec 13 | (concat 14 | syms 15 | (if vararg 16 | (list '& vararg)))) 17 | body)) 18 | 19 | (defn- sym-index 20 | "Get index based on the substring following the parameter's `%`. 21 | Zero means vararg." 22 | [n] 23 | (cond (= n "&") 0 24 | (= n "") 1 25 | (re-matches #"\d+" n) (js/parseInt n) 26 | :else (throw (js/Error. "arg literal must be %, %& or %integer.")))) 27 | 28 | ;; TODO: No promises available 29 | (defn- symbol->gensym 30 | "If symbol starting with `%`, convert to respective gensym." 31 | [sym-seq vararg? max-n sym] 32 | (if (symbol? sym) 33 | (let [nm (name sym)] 34 | (if (= (.indexOf nm "%") 0) 35 | (let [i (sym-index (subs nm 1))] 36 | ;; (if (and (= i 0) (not (realized? vararg?))) 37 | ;; (deliver vararg? true)) 38 | (swap! max-n max i) 39 | (nth sym-seq i)))))) 40 | 41 | ;; TODO: No promises available 42 | (defn- fn-walk 43 | "Walk the form and create an expand function form." 44 | [form] 45 | (let [syms (for [i (range) 46 | :let [base (if (= i 0) 47 | "rest__" 48 | (str "p" i "__")) 49 | s (name (gensym base))]] 50 | (symbol (str s "#"))) 51 | vararg? false ;(promise) 52 | max-n (atom 0) 53 | body (w/prewalk 54 | #(or (symbol->gensym syms vararg? max-n %) %) 55 | form)] 56 | (construct-fn 57 | (take @max-n (rest syms)) 58 | nil 59 | ;; (if (deref vararg? 0 nil) 60 | ;; (first syms)) 61 | body))) 62 | 63 | ;; ## Node 64 | 65 | (defrecord FnNode [children] 66 | node/Node 67 | (tag [_] :fn) 68 | (printable-only? [_] 69 | false) 70 | (sexpr [_] 71 | (fn-walk (node/sexprs children))) 72 | (length [_] 73 | (+ 3 (node/sum-lengths children))) 74 | (string [_] 75 | (str "#(" (node/concat-strings children) ")")) 76 | 77 | node/InnerNode 78 | (inner? [_] 79 | true) 80 | (children [_] 81 | children) 82 | (replace-children [this children'] 83 | (assoc this :children children')) 84 | 85 | Object 86 | (toString [this] 87 | (node/string this))) 88 | 89 | ;; TODO 90 | ;(node/make-printable! FnNode) 91 | 92 | ;; ## Constructor 93 | 94 | (defn fn-node 95 | "Create node representing an anonymous function." 96 | [children] 97 | (->FnNode children)) 98 | -------------------------------------------------------------------------------- /src/rewrite_clj/node/forms.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.node.forms 2 | (:require [rewrite-clj.node.protocols :as node])) 3 | 4 | ;; ## Node 5 | 6 | (defrecord FormsNode [children] 7 | node/Node 8 | (tag [_] 9 | :forms) 10 | (printable-only? [_] 11 | false) 12 | (sexpr [_] 13 | (let [es (node/sexprs children)] 14 | (if (next es) 15 | (list* 'do es) 16 | (first es)))) 17 | (length [_] 18 | (node/sum-lengths children)) 19 | (string [_] 20 | (node/concat-strings children)) 21 | 22 | node/InnerNode 23 | (inner? [_] 24 | true) 25 | (children [_] 26 | children) 27 | (replace-children [this children'] 28 | (assoc this :children children')) 29 | 30 | Object 31 | (toString [this] 32 | (node/string this))) 33 | 34 | ;; TODO: Macro fun ! 35 | ;(node/make-printable! FormsNode) 36 | 37 | ;; ## Constructor 38 | 39 | (defn forms-node 40 | "Create top-level node wrapping multiple children 41 | (equals an implicit `do` on the top-level)." 42 | [children] 43 | (->FormsNode children)) 44 | -------------------------------------------------------------------------------- /src/rewrite_clj/node/keyword.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.node.keyword 2 | (:require [rewrite-clj.node.protocols :as node])) 3 | 4 | ;; ## Node 5 | 6 | (defrecord KeywordNode [k namespaced?] 7 | node/Node 8 | (tag [_] :token) 9 | (printable-only? [_] false) 10 | (sexpr [_] 11 | (if (and namespaced? 12 | (not (namespace k))) 13 | ;; (keyword 14 | ;; (name (ns-name *ns*)) 15 | ;; (name k)) 16 | (throw (js/Error. "Namespaced keywords not supported !")) 17 | k)) 18 | (length [this] 19 | (let [c (inc (count (name k)))] 20 | (if namespaced? 21 | (inc c) 22 | (if-let [nspace (namespace k)] 23 | (+ 1 c (count nspace)) 24 | c)))) 25 | (string [_] 26 | (let [v (pr-str k)] 27 | (if namespaced? 28 | (str ":" v) 29 | v))) 30 | 31 | Object 32 | (toString [this] 33 | (node/string this))) 34 | 35 | 36 | 37 | 38 | ;; TODO 39 | ;;(node/make-printable! KeywordNode) 40 | 41 | ;; ## Constructor 42 | 43 | (defn keyword-node 44 | "Create node representing a keyword. If `namespaced?` is given as `true` 45 | a keyword à la `::x` or `::ns/x` (i.e. namespaced/aliased) is generated." 46 | [k & [namespaced?]] 47 | {:pre [(keyword? k)]} 48 | (->KeywordNode k namespaced?)) 49 | -------------------------------------------------------------------------------- /src/rewrite_clj/node/meta.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.node.meta 2 | (:require [rewrite-clj.node.protocols :as node] 3 | [rewrite-clj.node.whitespace :as ws])) 4 | 5 | ;; ## Node 6 | 7 | (defrecord MetaNode [tag prefix children] 8 | node/Node 9 | (tag [_] tag) 10 | (printable-only? [_] false) 11 | (sexpr [_] 12 | (let [[mta data] (node/sexprs children)] 13 | (assert (implements? IWithMeta data) 14 | (str "cannot attach metadata to: " (pr-str data))) 15 | (with-meta data (if (map? mta) mta {mta true})))) 16 | (length [_] 17 | (+ (count prefix) (node/sum-lengths children))) 18 | (string [_] 19 | (str prefix (node/concat-strings children))) 20 | 21 | node/InnerNode 22 | (inner? [_] true) 23 | (children [_] children) 24 | (replace-children [this children'] 25 | (node/assert-sexpr-count children' 2) 26 | (assoc this :children children')) 27 | 28 | Object 29 | (toString [this] 30 | (node/string this))) 31 | 32 | ;; TODO 33 | ;(node/make-printable! MetaNode) 34 | 35 | ;; ## Constructor 36 | 37 | (defn meta-node 38 | "Create node representing a form and its metadata." 39 | ([children] 40 | (node/assert-sexpr-count children 2) 41 | (->MetaNode :meta "^" children)) 42 | ([metadata data] 43 | (meta-node [metadata (ws/spaces 1) data]))) 44 | 45 | (defn raw-meta-node 46 | "Create node representing a form and its metadata using the 47 | `#^` prefix." 48 | ([children] 49 | (node/assert-sexpr-count children 2) 50 | (->MetaNode :meta* "#^" children)) 51 | ([metadata data] 52 | (raw-meta-node [metadata (ws/spaces 1) data]))) 53 | -------------------------------------------------------------------------------- /src/rewrite_clj/node/protocols.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.node.protocols 2 | (:require [clojure.string :as s])) 3 | 4 | 5 | 6 | (defprotocol Node 7 | "Protocol for EDN/Clojure nodes." 8 | (tag [_] 9 | "Keyword representing the type of the node.") 10 | (printable-only? [_] 11 | "Return true if the node cannot be converted to an s-expression 12 | element.") 13 | (sexpr [_] 14 | "Convert node to s-expression.") 15 | (length [_] 16 | "Get number of characters for the string version of this node.") 17 | (string [_] 18 | "Convert node to printable string.")) 19 | 20 | 21 | (extend-protocol Node 22 | object 23 | (tag [_] :unknown) 24 | (printable-only? [_] false) 25 | (sexpr [this] this) 26 | (length [this] (count (string this))) 27 | (string [this] (pr-str this))) 28 | 29 | (defn sexprs 30 | "Given a seq of nodes, convert those that represent s-expressions 31 | to the respective forms." 32 | [nodes] 33 | (->> nodes 34 | (remove printable-only?) 35 | (map sexpr))) 36 | 37 | (defn sum-lengths 38 | "Sum up lengths of the given nodes." 39 | [nodes] 40 | (reduce + (map length nodes))) 41 | 42 | (defn concat-strings 43 | "Convert nodes to strings and concatenate them." 44 | [nodes] 45 | (reduce str (map string nodes))) 46 | 47 | 48 | (defprotocol InnerNode 49 | "Protocol for non-leaf EDN/Clojure nodes." 50 | (inner? [_] 51 | "Check whether the node can contain children.") 52 | (children [_] 53 | "Get child nodes.") 54 | (replace-children [_ children] 55 | "Replace the node's children.")) 56 | 57 | (extend-protocol InnerNode 58 | object 59 | (inner? [_] false) 60 | (children [_] 61 | (throw (js/Error. "UnsupportedOperationException"))) 62 | (replace-children [_ _] 63 | (throw (js/Error. "UnsupportedOperationException")))) 64 | 65 | (defn child-sexprs 66 | "Get all child s-expressions for the given node." 67 | [node] 68 | (if (inner? node) 69 | (sexprs (children node)))) 70 | 71 | 72 | (defprotocol NodeCoerceable 73 | "Protocol for values that can be coerced to nodes." 74 | (coerce [_])) 75 | 76 | 77 | ;; TODO: Need to handle format !!!! 78 | ;; (defn- node->string 79 | ;; [node] 80 | ;; (let [n (str (if (printable-only? node) 81 | ;; (pr-str (string node)) 82 | ;; (string node))) 83 | ;; n' (if (re-find #"\n" n) 84 | ;; (->> (s/replace n #"\r?\n" "\n ") 85 | ;; (format "%n %s%n")) 86 | ;; (str " " n))] 87 | ;; (format "<%s:%s>" (name (tag node)) n'))) 88 | 89 | 90 | ;; (defn write-node 91 | ;; [writer node] 92 | ;; (str writer (node->string node))) 93 | 94 | 95 | ;; ## Helpers 96 | 97 | (defn assert-sexpr-count 98 | [nodes c] 99 | (assert 100 | (= (count (remove printable-only? nodes)) c) 101 | (str "can only contain" c " non-whitespace form(s)."))) 102 | 103 | (defn assert-single-sexpr 104 | [nodes] 105 | (assert-sexpr-count nodes 1)) 106 | -------------------------------------------------------------------------------- /src/rewrite_clj/node/quote.cljs: -------------------------------------------------------------------------------- 1 | (ns ^:no-doc rewrite-clj.node.quote 2 | (:require [rewrite-clj.node.protocols :as node])) 3 | 4 | ;; ## Node 5 | 6 | (defrecord QuoteNode [tag prefix sym children] 7 | node/Node 8 | (tag [_] tag) 9 | (printable-only? [_] false) 10 | (sexpr [_] 11 | (list sym (first (node/sexprs children)))) 12 | (length [_] 13 | (+ (count prefix) (node/sum-lengths children))) 14 | (string [_] 15 | (str prefix (node/concat-strings children))) 16 | 17 | node/InnerNode 18 | (inner? [_] true) 19 | (children [_] children) 20 | (replace-children [this children'] 21 | (node/assert-single-sexpr children') 22 | (assoc this :children children')) 23 | 24 | Object 25 | (toString [this] 26 | (node/string this))) 27 | 28 | ;(node/make-printable! QuoteNode) 29 | 30 | ;; ## Constructors 31 | 32 | (defn- ->node 33 | [t prefix sym children] 34 | (node/assert-single-sexpr children) 35 | (->QuoteNode t prefix sym children)) 36 | 37 | (defn quote-node 38 | "Create node representing a quoted form. 39 | Takes either a seq of nodes or a single one." 40 | [children] 41 | (if (sequential? children) 42 | (->node 43 | :quote "'" 'quote 44 | children) 45 | (recur [children]))) 46 | 47 | (defn syntax-quote-node 48 | "Create node representing a syntax-quoted form. 49 | Takes either a seq of nodes or a single one." 50 | [children] 51 | (if (sequential? children) 52 | (->node 53 | :syntax-quote "`" 'quote 54 | children) 55 | (recur [children]))) 56 | 57 | (defn unquote-node 58 | "Create node representing an unquoted form. (`~...`) 59 | Takes either a seq of nodes or a single one." 60 | [children] 61 | (if (sequential? children) 62 | (->node 63 | :unquote "~" 'unquote 64 | children) 65 | (recur [children]))) 66 | 67 | (defn unquote-splicing-node 68 | "Create node representing an unquote-spliced form. (`~@...`) 69 | Takes either a seq of nodes or a single one." 70 | [children] 71 | (if (sequential? children) 72 | (->node 73 | :unquote-splicing "~@" 'unquote-splicing 74 | children) 75 | (recur [children]))) 76 | -------------------------------------------------------------------------------- /src/rewrite_clj/node/reader_macro.cljs: -------------------------------------------------------------------------------- 1 | (ns ^:no-doc rewrite-clj.node.reader-macro 2 | (:require [rewrite-clj.node.protocols :as node] 3 | [rewrite-clj.node.whitespace :as ws])) 4 | 5 | ;; ## Node 6 | 7 | (defrecord ReaderNode [tag prefix suffix 8 | sexpr-fn sexpr-count 9 | children] 10 | node/Node 11 | (tag [_] tag) 12 | (printable-only? [_] 13 | (not sexpr-fn)) 14 | (sexpr [_] 15 | (if sexpr-fn 16 | (sexpr-fn (node/sexprs children)) 17 | (throw (js/Error. "Unsupported operation")))) 18 | (length [_] 19 | (-> (node/sum-lengths children) 20 | (+ 1 (count prefix) (count suffix)))) 21 | (string [_] 22 | (str "#" prefix (node/concat-strings children) suffix)) 23 | 24 | node/InnerNode 25 | (inner? [_] 26 | true) 27 | (children [_] 28 | children) 29 | (replace-children [this children'] 30 | (when sexpr-count 31 | (node/assert-sexpr-count children' sexpr-count)) 32 | (assoc this :children children')) 33 | 34 | Object 35 | (toString [this] 36 | (node/string this))) 37 | 38 | (defrecord ReaderMacroNode [children] 39 | node/Node 40 | (tag [_] :reader-macro) 41 | (printable-only?[_] false) 42 | (sexpr [this] 43 | (list 'read-string (node/string this))) 44 | (length [_] 45 | (inc (node/sum-lengths children))) 46 | (string [_] 47 | (str "#" (node/concat-strings children))) 48 | 49 | node/InnerNode 50 | (inner? [_] 51 | true) 52 | (children [_] 53 | children) 54 | (replace-children [this children'] 55 | (node/assert-sexpr-count children' 2) 56 | (assoc this :children children')) 57 | 58 | Object 59 | (toString [this] 60 | (node/string this))) 61 | 62 | (defrecord DerefNode [children] 63 | node/Node 64 | (tag [_] :deref) 65 | (printable-only?[_] false) 66 | (sexpr [this] 67 | (list* 'deref (node/sexprs children))) 68 | (length [_] 69 | (inc (node/sum-lengths children))) 70 | (string [_] 71 | (str "@" (node/concat-strings children))) 72 | 73 | node/InnerNode 74 | (inner? [_] 75 | true) 76 | (children [_] 77 | children) 78 | (replace-children [this children'] 79 | (node/assert-sexpr-count children' 1) 80 | (assoc this :children children')) 81 | 82 | Object 83 | (toString [this] 84 | (node/string this))) 85 | 86 | ;; TODO: 87 | ;; (node/make-printable! ReaderNode) 88 | ;; (node/make-printable! ReaderMacroNode) 89 | ;; (node/make-printable! DerefNode) 90 | 91 | ;; ## Constructors 92 | 93 | (defn- ->node 94 | [tag prefix suffix sexpr-fn sexpr-count children] 95 | (when sexpr-count 96 | (node/assert-sexpr-count children sexpr-count)) 97 | (->ReaderNode 98 | tag prefix suffix 99 | sexpr-fn sexpr-count 100 | children)) 101 | 102 | (defn var-node 103 | "Create node representing a var. 104 | Takes either a seq of nodes or a single one." 105 | [children] 106 | (if (sequential? children) 107 | (->node :var "'" "" #(list* 'var %) 1 children) 108 | (recur [children]))) 109 | 110 | (defn eval-node 111 | "Create node representing an inline evaluation. (`#=...`) 112 | Takes either a seq of nodes or a single one." 113 | [children] 114 | (if (sequential? children) 115 | (->node 116 | :eval "=" "" 117 | #(list 'eval (list* 'quote %)) 118 | 1 children) 119 | (recur [children]))) 120 | 121 | (defn reader-macro-node 122 | "Create node representing a reader macro. (`#... ...`)" 123 | ([children] 124 | (->ReaderMacroNode children)) 125 | ([macro-node form-node] 126 | (->ReaderMacroNode [macro-node (ws/spaces 1) form-node]))) 127 | 128 | (defn deref-node 129 | "Create node representing the dereferencing of a form. (`@...`) 130 | Takes either a seq of nodes or a single one." 131 | [children] 132 | (if (sequential? children) 133 | (->DerefNode children) 134 | (->DerefNode [children]))) 135 | -------------------------------------------------------------------------------- /src/rewrite_clj/node/seq.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.node.seq 2 | (:require [rewrite-clj.node.protocols :as node])) 3 | 4 | ;; ## Node 5 | 6 | (defn wrap-vec [s] (str "[" s "]")) 7 | (defn wrap-list [s] (str "(" s ")")) 8 | (defn wrap-set [s] (str "#{" s "}")) 9 | (defn wrap-map [s] (str "{" s "}")) 10 | 11 | 12 | 13 | (defrecord SeqNode [tag 14 | wrap-fn 15 | wrap-length 16 | seq-fn 17 | children] 18 | node/Node 19 | (tag [this] 20 | tag) 21 | (printable-only? [_] false) 22 | (sexpr [this] 23 | (seq-fn (node/sexprs children))) 24 | (length [_] 25 | (+ wrap-length (node/sum-lengths children))) 26 | (string [this] 27 | (->> (node/concat-strings children) 28 | wrap-fn)) 29 | 30 | node/InnerNode 31 | (inner? [_] 32 | true) 33 | (children [_] 34 | children) 35 | (replace-children [this children'] 36 | (assoc this :children children')) 37 | 38 | Object 39 | (toString [this] 40 | (node/string this))) 41 | 42 | ;; TODO 43 | ;(node/make-printable! SeqNode) 44 | 45 | ;; ## Constructors 46 | 47 | (defn list-node 48 | "Create a node representing an EDN list." 49 | [children] 50 | (->SeqNode :list wrap-list 2 #(apply list %) children)) 51 | 52 | (defn vector-node 53 | "Create a node representing an EDN vector." 54 | [children] 55 | (->SeqNode :vector wrap-vec 2 vec children)) 56 | 57 | (defn set-node 58 | "Create a node representing an EDN set." 59 | [children] 60 | (->SeqNode :set wrap-set 3 set children)) 61 | 62 | (defn map-node 63 | "Create a node representing an EDN map." 64 | [children] 65 | (->SeqNode :map wrap-map 2 #(apply hash-map %) children)) 66 | -------------------------------------------------------------------------------- /src/rewrite_clj/node/stringz.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.node.stringz 2 | (:require [rewrite-clj.node.protocols :as node] 3 | [cljs.tools.reader :as r] 4 | [clojure.string :as s])) 5 | 6 | ;; ## Node 7 | 8 | (defn- wrap-string 9 | [v] 10 | (str "\"" v "\"")) 11 | 12 | (defn- join-lines 13 | [lines] 14 | (s/join "\n" lines)) 15 | 16 | (defrecord StringNode [lines] 17 | node/Node 18 | (tag [_] 19 | (if (next lines) 20 | :multi-line 21 | :token)) 22 | (printable-only? [_] 23 | false) 24 | (sexpr [_] 25 | (join-lines 26 | (map 27 | (comp r/read-string wrap-string) 28 | lines))) 29 | (length [_] 30 | (+ 2 (reduce + (map count lines)))) 31 | (string [_] 32 | (wrap-string (join-lines lines))) 33 | 34 | Object 35 | (toString [this] 36 | (node/string this))) 37 | 38 | ;(node/make-printable! StringNode) 39 | 40 | ;; ## Constructors 41 | 42 | (defn string-node 43 | "Create node representing a string value. 44 | Takes either a seq of strings or a single one." 45 | [lines] 46 | (if (string? lines) 47 | (->StringNode [lines]) 48 | (->StringNode lines))) 49 | -------------------------------------------------------------------------------- /src/rewrite_clj/node/token.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.node.token 2 | (:require [rewrite-clj.node.protocols :as node])) 3 | 4 | ;; ## Node 5 | 6 | (defrecord TokenNode [value string-value] 7 | node/Node 8 | (tag [_] :token) 9 | (printable-only? [_] false) 10 | (sexpr [_] value) 11 | (length [_] (.-length string-value)) 12 | (string [_] string-value) 13 | 14 | Object 15 | (toString [this] 16 | (node/string this))) 17 | 18 | ; TODO 19 | ;(node/make-printable! TokenNode) 20 | 21 | ;; ## Constructor 22 | 23 | (defn token-node 24 | "Create node for an unspecified EDN token." 25 | ([value] 26 | (token-node value (pr-str value))) 27 | ([value string-value] 28 | (->TokenNode value string-value))) 29 | -------------------------------------------------------------------------------- /src/rewrite_clj/node/uneval.cljs: -------------------------------------------------------------------------------- 1 | (ns ^:no-doc rewrite-clj.node.uneval 2 | (:require [rewrite-clj.node.protocols :as node])) 3 | 4 | ;; ## Node 5 | 6 | (defrecord UnevalNode [children] 7 | node/Node 8 | (tag [_] :uneval) 9 | (printable-only? [_] true) 10 | (sexpr [_] 11 | (throw (js/Error. "Unsupported operation for unevalnode"))) 12 | (length [_] 13 | (+ 2 (node/sum-lengths children))) 14 | (string [_] 15 | (str "#_" (node/concat-strings children))) 16 | 17 | node/InnerNode 18 | (inner? [_] true) 19 | (children [_] children) 20 | (replace-children [this children'] 21 | (node/assert-single-sexpr children') 22 | (assoc this :children children')) 23 | 24 | Object 25 | (toString [this] 26 | (node/string this))) 27 | 28 | ;(node/make-printable! UnevalNode) 29 | 30 | ;; ## Constructor 31 | 32 | (defn uneval-node 33 | "Create node representing an EDN uneval `#_` form." 34 | [children] 35 | (if (sequential? children) 36 | (do 37 | (node/assert-single-sexpr children) 38 | (->UnevalNode children)) 39 | (recur [children]))) 40 | -------------------------------------------------------------------------------- /src/rewrite_clj/node/whitespace.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.node.whitespace 2 | (:require [rewrite-clj.node.protocols :as node])) 3 | 4 | ;; ## Newline Modifiers 5 | 6 | (def ^:dynamic *newline-fn* 7 | "This function is applied to every newline string." 8 | identity) 9 | 10 | (def ^:dynamic *count-fn* 11 | "This function is applied to every newline string and should produce 12 | the eventual character count." 13 | count) 14 | 15 | 16 | ;; TODO 17 | ;; (defmacro with-newline-fn 18 | ;; [f & body] 19 | ;; `(binding [*newline-fn* (comp *newline-fn* ~f)] 20 | ;; ~@body)) 21 | 22 | ;; (defmacro with-count-fn 23 | ;; [f & body] 24 | ;; `(binding [*count-fn* (comp *count-fn* ~f)] 25 | ;; ~@body)) 26 | 27 | ;; ## Nodes 28 | 29 | (defrecord WhitespaceNode [whitespace] 30 | node/Node 31 | (tag [_] :whitespace) 32 | (printable-only? [_] true) 33 | (sexpr [_] (throw (js/Error. "Unsupported operation"))) 34 | (length [_] (count whitespace)) 35 | (string [_] whitespace) 36 | 37 | Object 38 | (toString [this] 39 | (node/string this))) 40 | 41 | (defrecord NewlineNode [newlines] 42 | node/Node 43 | (tag [_] :newline) 44 | (printable-only? [_] true) 45 | (sexpr [_] (throw (js/Error. "Unsupported operation"))) 46 | (length [_] (*count-fn* newlines)) 47 | (string [_] (*newline-fn* newlines)) 48 | 49 | Object 50 | (toString [this] 51 | (node/string this))) 52 | 53 | 54 | ;; TODO 55 | ;; (node/make-printable! WhitespaceNode) 56 | ;; (node/make-printable! NewlineNode) 57 | 58 | ;; ## Constructors 59 | 60 | (defn whitespace-node 61 | "Create whitespace node." 62 | [s] 63 | (->WhitespaceNode s)) 64 | 65 | (defn newline-node 66 | "Create newline node." 67 | [s] 68 | (->NewlineNode s)) 69 | 70 | (defn- newline? 71 | "Check whether a character represents a linebreak." 72 | [c] 73 | (contains? #{\return \newline} c)) 74 | 75 | (defn whitespace-nodes 76 | "Convert a string of whitespace to whitespace/newline nodes." 77 | [s] 78 | (->> (partition-by newline? s) 79 | (map 80 | (fn [char-seq] 81 | (let [s (apply str char-seq)] 82 | (if (newline? (first char-seq)) 83 | (newline-node s) 84 | (whitespace-node s))))))) 85 | 86 | ;; ## Utilities 87 | 88 | (defn spaces 89 | "Create node representing the given number of spaces." 90 | [n] 91 | (whitespace-node (apply str (repeat n \space)))) 92 | 93 | (defn newlines 94 | "Create node representing the given number of newline characters." 95 | [n] 96 | (newline-node (apply str (repeat n \newline)))) 97 | 98 | 99 | 100 | (let [comma (whitespace-node ", ")] 101 | (defn comma-separated 102 | "Interleave the given seq of nodes with `\", \"` nodes." 103 | [nodes] 104 | (butlast (interleave nodes (repeat comma))))) 105 | 106 | (let [nl (newline-node "\n")] 107 | (defn line-separated 108 | "Interleave the given seq of nodes with newline nodes." 109 | [nodes] 110 | (butlast (interleave nodes (repeat nl))))) 111 | 112 | (let [space (whitespace-node " ")] 113 | (defn space-separated 114 | "Interleave the given seq of nodes with `\" \"` nodes." 115 | [nodes] 116 | (butlast (interleave nodes (repeat space))))) 117 | 118 | ;; ## Predicates 119 | 120 | (defn whitespace? 121 | "Check whether a node represents whitespace." 122 | [node] 123 | (contains? 124 | #{:whitespace 125 | :newline} 126 | (node/tag node))) 127 | 128 | (defn linebreak? 129 | "Check whether a ndoe represents linebreaks." 130 | [node] 131 | (= (node/tag node) :newline)) 132 | -------------------------------------------------------------------------------- /src/rewrite_clj/paredit.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.paredit 2 | "This namespace provides zipper operations for performing paredit type of 3 | operations on clojure/clojurescript forms. 4 | 5 | You might find inspirational examples here: http://pub.gajendra.net/src/paredit-refcard.pdf" 6 | (:require [rewrite-clj.zip :as z] 7 | [clojure.zip :as zz] 8 | [rewrite-clj.zip.whitespace :as ws] 9 | [rewrite-clj.zip.utils :as u] 10 | [rewrite-clj.node :as nd] 11 | [rewrite-clj.node.stringz :as sn :refer [StringNode] ] 12 | [clojure.string :as cstring])) 13 | 14 | 15 | 16 | 17 | ;;***************************** 18 | ;; Helpers 19 | ;;***************************** 20 | 21 | (defn- ^{:no-doc true} empty-seq? [zloc] 22 | (and (z/seq? zloc) (not (seq (z/sexpr zloc))))) 23 | 24 | ;; helper 25 | (defn ^{:no-doc true} move-n [loc f n] 26 | (if (= 0 n) 27 | loc 28 | (->> loc (iterate f) (take (inc n)) last))) 29 | 30 | (defn- ^{:no-doc true} top 31 | [zloc] 32 | (->> zloc 33 | (iterate z/up) 34 | (take-while identity) 35 | last)) 36 | 37 | ;; TODO : not very efficent ... 38 | (defn- ^{:no-doc true} global-find-by-node 39 | [zloc n] 40 | (-> zloc 41 | top 42 | (z/find zz/next #(= (meta (z/node %)) (meta n))))) 43 | 44 | 45 | 46 | (defn- ^{:no-doc true} nodes-by-dir 47 | ([zloc f] (nodes-by-dir zloc f constantly)) 48 | ([zloc f p?] 49 | (->> zloc 50 | (iterate f) 51 | (take-while identity) 52 | (take-while p?) 53 | (map z/node)))) 54 | 55 | (defn- ^{:no-doc true} remove-first-if-ws [nodes] 56 | (when (seq nodes) 57 | (if (nd/whitespace? (first nodes)) 58 | (rest nodes) 59 | nodes))) 60 | 61 | 62 | (defn- ^{:no-doc true} remove-ws-or-comment [zloc] 63 | (if-not (ws/whitespace-or-comment? zloc) 64 | zloc 65 | (recur (zz/remove zloc)))) 66 | 67 | 68 | (defn- ^{:no-doc true} create-seq-node 69 | "Creates a sequence node of given type `t` with node values of `v`" 70 | [t v] 71 | (case t 72 | :list (nd/list-node v) 73 | :vector (nd/vector-node v) 74 | :map (nd/map-node v) 75 | :set (nd/set-node v) 76 | (throw (js/Error. (str "Unsupported wrap type: " t))))) 77 | 78 | (defn- ^{:no-doc true} string-node? [zloc] 79 | (= (some-> zloc z/node type) (type (nd/string-node " ")))) 80 | 81 | ;;***************************** 82 | ;; Paredit functions 83 | ;;***************************** 84 | 85 | 86 | 87 | 88 | (defn kill 89 | "Kill all sibling nodes to the right of the current node 90 | 91 | - [1 2| 3 4] => [1 2|]" 92 | [zloc] 93 | (let [left (zz/left zloc)] 94 | (-> zloc 95 | (u/remove-right-while (constantly true)) 96 | zz/remove 97 | (#(if left 98 | (global-find-by-node % (z/node left)) 99 | %))))) 100 | 101 | 102 | 103 | (defn- ^{:no-doc true} kill-in-string-node [zloc pos] 104 | (if (= (z/string zloc) "\"\"") 105 | (z/remove zloc) 106 | (let [bounds (-> zloc z/node meta) 107 | row-idx (- (:row pos) (:row bounds)) 108 | sub-length (if-not (= (:row pos) (:row bounds)) 109 | (dec (:col pos)) 110 | (- (:col pos) (inc (:col bounds))))] 111 | 112 | (-> (take (inc row-idx) (-> zloc z/node :lines)) 113 | vec 114 | (update-in [row-idx] #(.substring % 0 sub-length)) 115 | (#(z/replace zloc (nd/string-node %))))))) 116 | 117 | (defn- ^{:no-doc true} kill-in-comment-node [zloc pos] 118 | (let [col-bounds (-> zloc z/node meta :col)] 119 | (if (= (:col pos) col-bounds) 120 | (z/remove zloc) 121 | (-> zloc 122 | (z/replace (-> zloc 123 | z/node 124 | :s 125 | (.substring 0 (- (:col pos) col-bounds 1)) 126 | nd/comment-node)) 127 | (#(if (zz/right %) 128 | (zz/insert-right % (nd/newlines 1)) 129 | %)))))) 130 | 131 | 132 | 133 | (defn kill-at-pos 134 | "In string and comment aware kill 135 | 136 | Perform kill for given position `pos` Like [[kill]], but: 137 | 138 | - if inside string kills to end of string and stops there 139 | - If inside comment kills to end of line (not including linebreak!) 140 | 141 | `pos` should provide `{:row :col }` which are relative to the start of the given form the zipper represents 142 | `zloc` must be positioned at a node previous (given depth first) to the node at given pos" 143 | [zloc pos] 144 | (if-let [candidate (z/find-last-by-pos zloc pos)] 145 | (cond 146 | (string-node? candidate) (kill-in-string-node candidate pos) 147 | (ws/comment? candidate) (kill-in-comment-node candidate pos) 148 | (and (empty-seq? candidate) 149 | (> (:col pos) (-> candidate z/node meta :col))) (z/remove candidate) 150 | :else (kill candidate)) 151 | zloc)) 152 | 153 | 154 | 155 | (defn- ^{:no-doc true} find-word-bounds 156 | [v col] 157 | (when (<= col (count v)) 158 | [(->> (seq v) 159 | (take col) 160 | reverse 161 | (take-while #(not (= % \space))) count (- col)) 162 | (->> (seq v) 163 | (drop col) 164 | (take-while #(not (or (= % \space) (= % \newline)))) 165 | count 166 | (+ col))])) 167 | 168 | 169 | (defn- ^{:no-doc true} remove-word-at 170 | [v col] 171 | (when-let [[start end] (find-word-bounds v col)] 172 | (str (.substring v 0 start) 173 | (.substring v end)))) 174 | 175 | 176 | 177 | (defn- ^{:no-doc true} kill-word-in-comment-node [zloc pos] 178 | (let [col-bounds (-> zloc z/node meta :col)] 179 | (-> zloc 180 | (z/replace (-> zloc 181 | z/node 182 | :s 183 | (remove-word-at (- (:col pos) col-bounds)) 184 | nd/comment-node))))) 185 | 186 | (defn- ^{:no-doc true} kill-word-in-string-node [zloc pos] 187 | (let [bounds (-> zloc z/node meta) 188 | row-idx (- (:row pos) (:row bounds)) 189 | col (if (= 0 row-idx) 190 | (- (:col pos) (:col bounds)) 191 | (:col pos))] 192 | (-> zloc 193 | (z/replace (-> zloc 194 | z/node 195 | :lines 196 | (update-in [row-idx] 197 | #(remove-word-at % col)) 198 | nd/string-node))))) 199 | 200 | 201 | 202 | (defn kill-one-at-pos 203 | "In string and comment aware kill for one node/word at given pos 204 | 205 | - `(+ |100 100) => (+ |100)` 206 | - `(for |(bar do)) => (foo)` 207 | - `\"|hello world\" => \"| world\"` 208 | - ` ; |hello world => ; |world`" 209 | [zloc pos] 210 | (if-let [candidate (->> (z/find-last-by-pos zloc pos) 211 | (ws/skip zz/right ws/whitespace?))] 212 | (let [bounds (-> candidate z/node meta) 213 | kill-in-node? (not (and (= (:row pos) (:row bounds)) 214 | (<= (:col pos) (:col bounds))))] 215 | (cond 216 | (and kill-in-node? (string-node? candidate)) (kill-word-in-string-node candidate pos) 217 | (and kill-in-node? (ws/comment? candidate)) (kill-word-in-comment-node candidate pos) 218 | (not (z/leftmost? candidate)) (-> (z/remove candidate) 219 | (global-find-by-node (-> candidate z/left z/node))) 220 | :else (z/remove candidate))) 221 | zloc)) 222 | 223 | 224 | (defn- ^{:no-doc true} find-slurpee-up [zloc f] 225 | (loop [l (z/up zloc) 226 | n 1] 227 | (cond 228 | (nil? l) nil 229 | (not (nil? (f l))) [n (f l)] 230 | (nil? (z/up l)) nil 231 | :else (recur (z/up l) (inc n))))) 232 | 233 | (defn- ^{:no-doc true} find-slurpee [zloc f] 234 | (if (empty-seq? zloc) 235 | [(f zloc) 0] 236 | (some-> zloc (find-slurpee-up f) reverse))) 237 | 238 | 239 | 240 | 241 | (defn slurp-forward 242 | "Pull in next right outer node (if none at first level, tries next etc) into 243 | current S-expression 244 | 245 | - `[1 2 [|3] 4 5] => [1 2 [|3 4] 5]`" 246 | [zloc] 247 | (let [[slurpee-loc n-ups] (find-slurpee zloc z/right)] 248 | (if-not slurpee-loc 249 | zloc 250 | (let [slurper-loc (move-n zloc z/up n-ups) 251 | preserves (->> (-> slurper-loc 252 | zz/right 253 | (nodes-by-dir zz/right #(not (= (z/node slurpee-loc) (z/node %))))) 254 | (filter #(or (nd/linebreak? %) (nd/comment? %))))] 255 | (-> slurper-loc 256 | (u/remove-right-while ws/whitespace-or-comment?) 257 | u/remove-right 258 | ((partial reduce z/append-child) preserves) 259 | (z/append-child (z/node slurpee-loc)) 260 | (#(if (empty-seq? zloc) 261 | (-> % z/down (u/remove-left-while ws/whitespace?)) 262 | (global-find-by-node % (z/node zloc))))))))) 263 | 264 | (defn slurp-forward-fully 265 | "Pull in all right outer-nodes into current S-expression, but only the ones at the same level 266 | as the the first one. 267 | 268 | - `[1 2 [|3] 4 5] => [1 2 [|3 4 5]]`" 269 | [zloc] 270 | (let [curr-slurpee (some-> zloc (find-slurpee z/right) first) 271 | num-slurps (some-> curr-slurpee (nodes-by-dir z/right) count inc)] 272 | 273 | (->> zloc 274 | (iterate slurp-forward) 275 | (take num-slurps) 276 | last))) 277 | 278 | 279 | (defn slurp-backward 280 | "Pull in prev left outer node (if none at first level, tries next etc) into 281 | current S-expression 282 | 283 | - `[1 2 [|3] 4 5] => [1 [2 |3] 4 5]`" 284 | [zloc] 285 | (if-let [[slurpee-loc _] (find-slurpee zloc z/left)] 286 | (let [preserves (->> (-> slurpee-loc 287 | zz/right 288 | (nodes-by-dir zz/right ws/whitespace-or-comment?)) 289 | (filter #(or (nd/linebreak? %) (nd/comment? %))))] 290 | (-> slurpee-loc 291 | (u/remove-left-while ws/whitespace-not-linebreak?) 292 | (#(if (and (z/left slurpee-loc) 293 | (not (ws/linebreak? (zz/left %)))) 294 | (ws/prepend-space %) 295 | %)) 296 | (u/remove-right-while ws/whitespace-or-comment?) 297 | zz/remove 298 | z/next 299 | ((partial reduce z/insert-child) preserves) 300 | (z/insert-child (z/node slurpee-loc)) 301 | (#(if (empty-seq? zloc) 302 | (-> % z/down (u/remove-right-while ws/linebreak?)) 303 | (global-find-by-node % (z/node zloc)))))) 304 | zloc)) 305 | 306 | (defn slurp-backward-fully 307 | "Pull in all left outer-nodes into current S-expression, but only the ones at the same level 308 | as the the first one. 309 | 310 | - `[1 2 [|3] 4 5] => [[1 2 |3] 4 5]`" 311 | [zloc] 312 | (let [curr-slurpee (some-> zloc (find-slurpee z/left) first) 313 | num-slurps (some-> curr-slurpee (nodes-by-dir z/left) count inc)] 314 | 315 | (->> zloc 316 | (iterate slurp-backward) 317 | (take num-slurps) 318 | last))) 319 | 320 | 321 | (defn barf-forward 322 | "Push out the rightmost node of the current S-expression into outer right form 323 | 324 | - `[1 2 [|3 4] 5] => [1 2 [|3] 4 5]`" 325 | [zloc] 326 | (let [barfee-loc (z/rightmost zloc)] 327 | 328 | (if-not (z/up zloc) 329 | zloc 330 | (let [preserves (->> (-> barfee-loc 331 | zz/left 332 | (nodes-by-dir zz/left ws/whitespace-or-comment?)) 333 | (filter #(or (nd/linebreak? %) (nd/comment? %))) 334 | reverse)] 335 | (-> barfee-loc 336 | (u/remove-left-while ws/whitespace-or-comment?) 337 | (u/remove-right-while ws/whitespace?) 338 | u/remove-and-move-up 339 | (z/insert-right (z/node barfee-loc)) 340 | ((partial reduce z/insert-right) preserves) 341 | (#(or (global-find-by-node % (z/node zloc)) 342 | (global-find-by-node % (z/node barfee-loc))))))))) 343 | 344 | 345 | (defn barf-backward 346 | "Push out the leftmost node of the current S-expression into outer left form 347 | 348 | - `[1 2 [3 |4] 5] => [1 2 3 [|4] 5]`" 349 | [zloc] 350 | (let [barfee-loc (z/leftmost zloc)] 351 | (if-not (z/up zloc) 352 | zloc 353 | (let [preserves (->> (-> barfee-loc 354 | zz/right 355 | (nodes-by-dir zz/right ws/whitespace-or-comment?)) 356 | (filter #(or (nd/linebreak? %) (nd/comment? %))))] 357 | (-> barfee-loc 358 | (u/remove-left-while ws/whitespace?) 359 | (u/remove-right-while ws/whitespace-or-comment?) ;; probably insert space when on same line ! 360 | zz/remove 361 | (z/insert-left (z/node barfee-loc)) 362 | ((partial reduce z/insert-left) preserves) 363 | (#(or (global-find-by-node % (z/node zloc)) 364 | (global-find-by-node % (z/node barfee-loc))))))))) 365 | 366 | 367 | (defn wrap-around 368 | "Wrap current node with a given type `t` (:vector, :list, :set, :map :fn) 369 | 370 | - `|123 => [|123] ; given :vector` 371 | - `|[1 [2]] => [|[1 [2]]]`" 372 | [zloc t] 373 | (-> zloc 374 | (z/insert-left (create-seq-node t nil)) 375 | z/left 376 | (u/remove-right-while ws/whitespace?) 377 | u/remove-right 378 | (zz/append-child (z/node zloc)) 379 | z/down)) 380 | 381 | (defn wrap-fully-forward-slurp 382 | "Create a new seq node of type `t` left of `zloc` then slurp fully into the new node 383 | 384 | - `[1 |2 3 4] => [1 [|2 3 4]]`" 385 | [zloc t] 386 | (-> zloc 387 | (z/insert-left (create-seq-node t nil)) 388 | z/left 389 | slurp-forward-fully)) 390 | 391 | (def splice 392 | "See rewrite-clj.zip/splice" 393 | z/splice) 394 | 395 | 396 | (defn- ^{:no-doc true} splice-killing 397 | [zloc f] 398 | (if-not (z/up zloc) 399 | zloc 400 | (-> zloc 401 | (f (constantly true)) 402 | z/up 403 | splice 404 | (global-find-by-node (z/node zloc))))) 405 | 406 | (defn splice-killing-backward 407 | "Remove left siblings of current given node in S-Expression and unwrap remaining into enclosing S-expression 408 | 409 | - `(foo (let ((x 5)) |(sqrt n)) bar) => (foo (sqrt n) bar)`" 410 | [zloc] 411 | (splice-killing zloc u/remove-left-while)) 412 | 413 | (defn splice-killing-forward 414 | "Remove current given node and its right siblings in S-Expression and unwrap remaining into enclosing S-expression 415 | 416 | - `(a (b c |d e) f) => (a b |c f)`" 417 | [zloc] 418 | (if (and (z/up zloc) (not (z/leftmost? zloc))) 419 | (splice-killing (z/left zloc) u/remove-right-while) 420 | (if (z/up zloc) 421 | (-> zloc z/up z/remove) 422 | zloc))) 423 | 424 | 425 | (defn split 426 | "Split current s-sexpression in two at given node `zloc` 427 | 428 | - `[1 2 |3 4 5] => [1 2 3] [4 5]`" 429 | [zloc] 430 | (let [parent-loc (z/up zloc)] 431 | (if-not parent-loc 432 | zloc 433 | (let [t (z/tag parent-loc) 434 | lefts (reverse (remove-first-if-ws (rest (nodes-by-dir (z/right zloc) zz/left)))) 435 | rights (remove-first-if-ws (nodes-by-dir (z/right zloc) zz/right))] 436 | 437 | (if-not (and (seq lefts) (seq rights)) 438 | zloc 439 | (-> parent-loc 440 | (z/insert-left (create-seq-node t lefts)) 441 | (z/insert-left (create-seq-node t rights)) 442 | z/remove 443 | (#(or (global-find-by-node % (z/node zloc)) 444 | (global-find-by-node % (last lefts)))))))))) 445 | 446 | 447 | (defn- ^{:no-doc true} split-string [zloc pos] 448 | (let [bounds (-> zloc z/node meta) 449 | row-idx (- (:row pos) (:row bounds)) 450 | lines (-> zloc z/node :lines) 451 | split-col (if-not (= (:row pos) (:row bounds)) 452 | (dec (:col pos)) 453 | (- (:col pos) (inc (:col bounds))))] 454 | (-> zloc 455 | (z/replace (nd/string-node 456 | (-> (take (inc row-idx) lines) 457 | vec 458 | (update-in [row-idx] #(.substring % 0 split-col))))) 459 | (z/insert-right (nd/string-node 460 | (-> (drop row-idx lines) 461 | vec 462 | (update-in [0] #(.substring % split-col)))))))) 463 | 464 | 465 | (defn split-at-pos 466 | "In string aware split 467 | 468 | Perform split at given position `pos` Like split, but: 469 | 470 | - if inside string splits string into two strings 471 | 472 | `pos` should provide `{:row :col }` which are relative to the start of the given form the zipper represents 473 | `zloc` must be positioned at a node previous (given depth first) to the node at given pos" 474 | [zloc pos] 475 | (if-let [candidate (z/find-last-by-pos zloc pos)] 476 | (if (string-node? candidate) 477 | (split-string candidate pos) 478 | (split candidate)) 479 | zloc)) 480 | 481 | (defn- ^{:no-doc true} join-seqs [left right] 482 | (let [lefts (-> left z/node nd/children) 483 | ws-nodes (-> (zz/right left) (nodes-by-dir zz/right ws/whitespace-or-comment?)) 484 | rights (-> right z/node nd/children)] 485 | 486 | (-> right 487 | zz/remove 488 | remove-ws-or-comment 489 | z/up 490 | (z/insert-left (create-seq-node :vector 491 | (concat lefts 492 | ws-nodes 493 | rights))) 494 | z/remove 495 | (global-find-by-node (first rights))))) 496 | 497 | 498 | (defn- ^{:no-doc true} join-strings [left right] 499 | (-> right 500 | zz/remove 501 | remove-ws-or-comment 502 | (z/replace (nd/string-node (str (-> left z/node nd/sexpr) 503 | (-> right z/node nd/sexpr)))))) 504 | 505 | (defn join 506 | "Join S-expression to the left and right of current loc. Also works for strings. 507 | 508 | - `[[1 2] |[3 4]] => [[1 2 3 4]]` 509 | - `[\"Hello \" | \"World\"] => [\"Hello World\"]" 510 | [zloc] 511 | (let [left (some-> zloc z/left) 512 | right (if (some-> zloc z/node nd/whitespace?) (z/right zloc) zloc)] 513 | 514 | 515 | (if-not (and left right) 516 | zloc 517 | (cond 518 | (and (z/seq? left) (z/seq? right)) (join-seqs left right) 519 | (and (string-node? left) (string-node? right)) (join-strings left right) 520 | :else zloc)))) 521 | 522 | 523 | (defn raise 524 | "Delete siblings and raise node at zloc one level up 525 | 526 | - `[1 [2 |3 4]] => [1 |3]`" 527 | [zloc] 528 | (if-let [containing (z/up zloc)] 529 | (-> containing 530 | (z/replace (z/node zloc))) 531 | zloc)) 532 | 533 | 534 | (defn move-to-prev 535 | "Move node at current location to the position of previous location given a depth first traversal 536 | 537 | - `(+ 1 (+ 2 |3) 4) => (+ 1 (+ |3 2) 4)` 538 | - `(+ 1 (+ 2 3) |4) => (+ 1 (+ 2 3 |4))` 539 | 540 | returns zloc after move or given zloc if a move isn't possible" 541 | [zloc] 542 | (let [n (z/node zloc) 543 | p (some-> zloc z/left z/node) 544 | ins-fn (if (or (nil? p) (= (-> zloc z/remove z/node) p)) 545 | #(-> % (z/insert-left n) z/left) 546 | #(-> % (z/insert-right n) z/right))] 547 | (if-not (-> zloc z/remove z/prev) 548 | zloc 549 | (-> zloc 550 | z/remove 551 | ins-fn)))) 552 | -------------------------------------------------------------------------------- /src/rewrite_clj/parser.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.parser 2 | (:require [rewrite-clj.parser.core :as p] 3 | [rewrite-clj.node :as node] 4 | [rewrite-clj.reader :as r])) 5 | 6 | ;; ## Parser Core 7 | 8 | (defn parse 9 | "Parse next form from the given reader." 10 | [^not-native reader] 11 | (p/parse-next reader)) 12 | 13 | (defn parse-all 14 | "Parse all forms from the given reader." 15 | [^not-native reader] 16 | (let [nodes (->> (repeatedly #(parse reader)) 17 | (take-while identity) 18 | (doall))] 19 | (with-meta 20 | (node/forms-node nodes) 21 | (meta (first nodes))))) 22 | 23 | ;; ## Specialized Parsers 24 | 25 | (defn parse-string 26 | "Parse first form in the given string." 27 | [s] 28 | (parse (r/indexing-push-back-reader s))) 29 | 30 | (defn parse-string-all 31 | "Parse all forms in the given string." 32 | [s] 33 | (parse-all (r/indexing-push-back-reader s))) 34 | 35 | 36 | -------------------------------------------------------------------------------- /src/rewrite_clj/parser/core.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.parser.core 2 | (:require [rewrite-clj.node :as node] 3 | [rewrite-clj.reader :as reader] 4 | [rewrite-clj.parser.keyword :refer [parse-keyword]] 5 | [rewrite-clj.parser.string :refer [parse-string parse-regex]] 6 | [rewrite-clj.parser.token :refer [parse-token]] 7 | [rewrite-clj.parser.whitespace :refer [parse-whitespace]] 8 | [cljs.tools.reader.reader-types :refer [peek-char]])) 9 | 10 | ;; ## Base Parser 11 | 12 | (def ^:dynamic ^:private *delimiter* 13 | nil) 14 | 15 | 16 | (declare parse-next) 17 | 18 | 19 | (defn- parse-delim 20 | [^not-native reader delimiter] 21 | (reader/ignore reader) 22 | (->> #(binding [*delimiter* delimiter] 23 | (parse-next %)) 24 | (reader/read-repeatedly reader))) 25 | 26 | (defn- parse-printables 27 | [^not-native reader node-tag n & [ignore?]] 28 | (when ignore? 29 | (reader/ignore reader)) 30 | (reader/read-n 31 | reader 32 | node-tag 33 | parse-next 34 | (complement node/printable-only?) 35 | n)) 36 | 37 | 38 | (defn- parse-meta 39 | [^not-native reader] 40 | (reader/ignore reader) 41 | (node/meta-node (parse-printables reader :meta 2))) 42 | 43 | 44 | (defn- parse-eof 45 | [^not-native reader] 46 | (when *delimiter* 47 | (reader/throw-reader reader "Unexpected EOF."))) 48 | 49 | ;; ### Seqs 50 | 51 | (defn- parse-list 52 | [^not-native reader] 53 | (node/list-node (parse-delim reader \)))) 54 | 55 | (defn- parse-vector 56 | [^not-native reader] 57 | (node/vector-node (parse-delim reader \]))) 58 | 59 | (defn- parse-map 60 | [^not-native reader] 61 | (node/map-node (parse-delim reader \}))) 62 | 63 | 64 | ;; ### Reader Specialities 65 | 66 | 67 | (defn- parse-conditional [reader] 68 | ;; we need to examine the next character, so consume one (known \?) 69 | (reader/next reader) 70 | ;; we will always have a reader-macro-node as the result 71 | (node/reader-macro-node 72 | (let [read1 (fn [] (parse-printables reader :reader-macro 1))] 73 | (cons (case (reader/peek reader) 74 | ;; the easy case, just emit a token 75 | \( (node/token-node (symbol "?")) 76 | 77 | ;; the harder case, match \@, consume it and emit the token 78 | \@ (do (reader/next reader) 79 | (node/token-node (symbol "?@"))) 80 | 81 | ;; otherwise no idea what we're reading but its \? prefixed 82 | (do (reader/unread reader \?) 83 | (first (read1)))) 84 | (read1))))) 85 | 86 | 87 | 88 | (defn- parse-sharp 89 | [^not-native reader] 90 | (reader/ignore reader) 91 | (case (peek-char reader) 92 | nil (reader/throw-reader reader "Unexpected EOF.") 93 | \{ (node/set-node (parse-delim reader \})) 94 | \( (node/fn-node (parse-delim reader \))) 95 | \" (parse-regex reader) 96 | \^ (node/meta-node (parse-printables reader :meta 2 true)) 97 | \' (node/var-node (parse-printables reader :var 1 true)) 98 | \= (node/eval-node (parse-printables reader :eval 1 true)) 99 | \_ (node/uneval-node (parse-printables reader :uneval 1 true)) 100 | \? (parse-conditional reader) 101 | (node/reader-macro-node (parse-printables reader :reader-macro 2)))) 102 | 103 | 104 | 105 | 106 | (defn- parse-unmatched 107 | [^not-native reader] 108 | (reader/throw-reader 109 | reader 110 | "Unmatched delimiter: %s" 111 | (peek-char reader))) 112 | 113 | 114 | (defn- parse-deref 115 | [^not-native reader] 116 | (node/deref-node (parse-printables reader :deref 1 true))) 117 | 118 | ;; ## Quotes 119 | 120 | (defn- parse-quote 121 | [^not-native reader] 122 | (node/quote-node (parse-printables reader :quote 1 true))) 123 | 124 | (defn- parse-syntax-quote 125 | [^not-native reader] 126 | (node/syntax-quote-node (parse-printables reader :syntax-quote 1 true))) 127 | 128 | (defn- parse-unquote 129 | [^not-native reader] 130 | (reader/ignore reader) 131 | (let [c (peek-char reader)] 132 | (if (= c \@) 133 | (node/unquote-splicing-node 134 | (parse-printables reader :unquote 1 true)) 135 | (node/unquote-node 136 | (parse-printables reader :unquote 1))))) 137 | 138 | (defn- parse-comment 139 | [^not-native reader] 140 | (reader/ignore reader) 141 | (node/comment-node (reader/read-include-linebreak reader))) 142 | 143 | 144 | 145 | (defn- dispatch 146 | [c] 147 | (cond (nil? c) parse-eof 148 | (identical? c *delimiter*) reader/ignore 149 | (reader/whitespace? c) parse-whitespace 150 | (identical? c \^) parse-meta 151 | (identical? c \#) parse-sharp 152 | (identical? c \() parse-list 153 | (identical? c \[) parse-vector 154 | (identical? c \{) parse-map 155 | (identical? c \}) parse-unmatched 156 | (identical? c \]) parse-unmatched 157 | (identical? c \)) parse-unmatched 158 | (identical? c \~) parse-unquote 159 | (identical? c \') parse-quote 160 | (identical? c \`) parse-syntax-quote 161 | (identical? c \;) parse-comment 162 | (identical? c \@) parse-deref 163 | (identical? c \") parse-string 164 | (identical? c \:) parse-keyword 165 | :else parse-token)) 166 | 167 | 168 | (defn parse-next 169 | [^not-native rdr] 170 | (reader/read-with-meta rdr (dispatch (peek-char rdr)))) 171 | -------------------------------------------------------------------------------- /src/rewrite_clj/parser/keyword.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.parser.keyword 2 | (:require [rewrite-clj.node :as node] 3 | [cljs.tools.reader.reader-types] 4 | [rewrite-clj.reader :as r])) 5 | 6 | (defn parse-keyword 7 | [^not-native reader] 8 | (r/read-char reader) 9 | (if-let [c (r/peek-char reader)] 10 | (if (identical? c \:) 11 | (node/keyword-node 12 | (r/read-keyword reader ":") 13 | true) 14 | (do 15 | (r/unread reader \:) 16 | (node/keyword-node (r/read-keyword reader ":")))) 17 | (r/throw-reader reader "unexpected EOF while reading keyword."))) 18 | -------------------------------------------------------------------------------- /src/rewrite_clj/parser/string.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.parser.string 2 | (:require [rewrite-clj.node :as node] 3 | [rewrite-clj.reader :as r] 4 | [goog.string :as gstring] 5 | [clojure.string :as string])) 6 | 7 | (defn- flush-into 8 | "Flush buffer and add string to the given vector." 9 | [lines buf] 10 | (let [s (.toString buf)] 11 | (.set buf "") 12 | (conj lines s))) 13 | 14 | (defn- read-string-data 15 | [^not-native reader] 16 | (r/ignore reader) 17 | (let [buf (gstring/StringBuffer.)] 18 | (loop [escape? false 19 | lines []] 20 | (if-let [c (r/read-char reader)] 21 | (cond (and (not escape?) (identical? c \")) 22 | (flush-into lines buf) 23 | 24 | (identical? c \newline) 25 | (recur escape? (flush-into lines buf)) 26 | 27 | :else 28 | (do 29 | (.append buf c) 30 | (recur (and (not escape?) (identical? c \\)) lines))) 31 | (r/throw-reader reader "Unexpected EOF while reading string."))))) 32 | 33 | (defn parse-string 34 | [^not-native reader] 35 | (node/string-node (read-string-data reader))) 36 | 37 | (defn parse-regex 38 | [^not-native reader] 39 | (let [lines (read-string-data reader) 40 | regex (string/join "\n" lines)] 41 | (node/token-node (re-pattern regex) (str "#\"" regex "\"")))) 42 | -------------------------------------------------------------------------------- /src/rewrite_clj/parser/token.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.parser.token 2 | (:require [rewrite-clj.node :as node] 3 | [rewrite-clj.reader :as r] 4 | [goog.string :as gstring])) 5 | 6 | 7 | (defn- join-2 [a b] 8 | (-> a gstring/StringBuffer. (.append b) .toString)) 9 | 10 | (defn- ^boolean allowed-default? [c] 11 | false) 12 | 13 | (defn- ^boolean allowed-suffix? [c] 14 | (or (identical? c \') 15 | (identical? c \:))) 16 | 17 | 18 | 19 | (defn- read-to-boundary 20 | [^not-native reader allowed?] 21 | (r/read-until 22 | reader 23 | #(and (not (allowed? %)) 24 | (r/whitespace-or-boundary? %)))) 25 | 26 | 27 | 28 | 29 | (defn- read-to-char-boundary 30 | [^not-native reader] 31 | (let [c (r/read-char reader)] 32 | (join-2 c (if (not (identical? c \\)) 33 | (read-to-boundary reader allowed-default?) 34 | "")))) 35 | 36 | 37 | 38 | (defn- symbol-node 39 | "Symbols allow for certain boundary characters that have 40 | to be handled explicitly." 41 | [^not-native reader value value-string] 42 | (let [suffix (read-to-boundary 43 | reader 44 | allowed-suffix?)] 45 | (if (empty? suffix) 46 | (node/token-node value value-string) 47 | (let [s (join-2 value-string suffix)] 48 | (node/token-node 49 | (r/read-string s) 50 | s))))) 51 | 52 | 53 | 54 | 55 | (defn parse-token 56 | "Parse a single token." 57 | [^not-native reader] 58 | (let [first-char (r/read-char reader) 59 | s (join-2 first-char (if (identical? first-char \\) 60 | (read-to-char-boundary reader) 61 | (read-to-boundary reader allowed-default?))) 62 | v (r/read-string s)] 63 | (if (symbol? v) 64 | (symbol-node reader v s) 65 | (node/token-node v s)))) 66 | -------------------------------------------------------------------------------- /src/rewrite_clj/parser/whitespace.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.parser.whitespace 2 | (:require [rewrite-clj.node :as node] 3 | [rewrite-clj.reader :as r])) 4 | 5 | (defn parse-whitespace 6 | "Parse as much whitespace as possible. The created node can either contain 7 | only linebreaks or only space/tabs." 8 | [^not-native reader] 9 | (if (r/linebreak? (r/peek-char reader)) 10 | (node/newline-node 11 | (r/read-while reader r/linebreak?)) 12 | (node/whitespace-node 13 | (r/read-while reader r/space?)))) 14 | -------------------------------------------------------------------------------- /src/rewrite_clj/reader.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.reader 2 | (:refer-clojure :exclude [peek next]) 3 | (:require [cljs.tools.reader :as r] 4 | [cljs.tools.reader.reader-types :as reader-types] 5 | [cljs.tools.reader.impl.commons :refer [parse-symbol]] 6 | [goog.string :as gstring] 7 | [rewrite-clj.node.protocols :as nd])) 8 | 9 | (def read-char reader-types/read-char) 10 | (def get-column-number reader-types/get-column-number) 11 | (def get-line-number reader-types/get-line-number) 12 | (def peek-char reader-types/peek-char) 13 | (def indexing-push-back-reader reader-types/indexing-push-back-reader) 14 | (def unread reader-types/unread) 15 | (def read-string r/read-string) 16 | 17 | ;; TODO: try to get goog.string.format up and running ! 18 | (defn throw-reader 19 | "Throw reader exception, including line/column." 20 | [^not-native reader fmt & data] 21 | (let [c (get-column-number reader) 22 | l (get-line-number reader)] 23 | (throw 24 | (js/Error. 25 | (str data fmt 26 | " [at line " l ", column " c "]"))))) 27 | 28 | 29 | (defn boundary? 30 | "Check whether a given char is a token boundary." 31 | [c] 32 | (< -1 (.indexOf #js [\" \: \; \' \@ \^ \` \~ 33 | \( \) \[ \] \{ \} \\ nil] c))) 34 | 35 | (defn ^boolean whitespace? 36 | "Checks whether a given character is whitespace" 37 | [ch] 38 | ;(or (gstring/isBreakingWhitespace ch) (identical? \, ch)) 39 | (< -1 (.indexOf #js [\return \newline \tab \space ","] ch))) 40 | 41 | (defn ^boolean linebreak? 42 | "Checks whether the character is a newline" 43 | [c] 44 | (< -1 (.indexOf #js [\return \newline] c))) 45 | 46 | (defn ^boolean space? 47 | "Checks whether the character is a space" 48 | [c] 49 | (< -1 (.indexOf #js [\tab \space ","] c))) 50 | 51 | (defn ^boolean whitespace-or-boundary? 52 | [c] 53 | (or (whitespace? c) (boundary? c))) 54 | 55 | (def buf (gstring/StringBuffer. "")) 56 | 57 | (defn read-while 58 | "Read while the chars fulfill the given condition. Ignores 59 | the unmatching char." 60 | ([^not-native reader p?] 61 | (read-while reader p? (not (p? nil)))) 62 | 63 | ([^not-native reader p? eof?] 64 | (.clear buf) 65 | (loop [] 66 | (if-let [c (read-char reader)] 67 | (if (p? c) 68 | (do 69 | (.append buf c) 70 | (recur)) 71 | (do 72 | (unread reader c) 73 | (.toString buf))) 74 | (if eof? 75 | (.toString buf) 76 | (throw-reader reader "Unexpected EOF.")))))) 77 | 78 | (defn read-until 79 | "Read until a char fulfills the given condition. Ignores the 80 | matching char." 81 | [^not-native reader p?] 82 | (read-while 83 | reader 84 | (complement p?) 85 | (p? nil))) 86 | 87 | (defn read-include-linebreak 88 | "Read until linebreak and include it." 89 | [^not-native reader] 90 | (str 91 | (read-until 92 | reader 93 | #(or (nil? %) (linebreak? %))) 94 | (read-char reader))) 95 | 96 | (defn string->edn 97 | "Convert string to EDN value." 98 | [s] 99 | (read-string s)) 100 | 101 | (defn ignore 102 | "Ignore the next character." 103 | [^not-native reader] 104 | (read-char reader) 105 | nil) 106 | 107 | 108 | (defn next 109 | "Read next char." 110 | [^not-native reader] 111 | (read-char reader)) 112 | 113 | (defn peek 114 | "Peek next char." 115 | [^not-native reader] 116 | (peek-char reader)) 117 | 118 | 119 | 120 | (defn read-with-meta 121 | "Use the given function to read value, then attach row/col metadata." 122 | [^not-native reader read-fn] 123 | (let [row (get-line-number reader) 124 | col (get-column-number reader) 125 | ^not-native entry (read-fn reader)] 126 | (when entry 127 | (let [end-row (get-line-number reader) 128 | end-col (get-column-number reader) 129 | end-col (if (= 0 end-col) 130 | (+ col (.-length (nd/string entry))) 131 | end-col)] ; TODO: Figure out why numbers are sometimes whacky 132 | (if (= 0 col) ; why oh why 133 | entry 134 | (-with-meta 135 | entry 136 | {:row row 137 | :col col 138 | :end-row end-row 139 | :end-col end-col})))))) 140 | 141 | (defn read-repeatedly 142 | "Call the given function on the given reader until it returns 143 | a non-truthy value." 144 | [^not-native reader read-fn] 145 | (->> (repeatedly #(read-fn reader)) 146 | (take-while identity) 147 | (doall))) 148 | 149 | 150 | (defn read-n 151 | "Call the given function on the given reader until `n` values matching `p?` have been 152 | collected." 153 | [^not-native reader node-tag read-fn p? n] 154 | {:pre [(pos? n)]} 155 | (loop [c 0 156 | vs []] 157 | (if (< c n) 158 | (if-let [v (read-fn reader)] 159 | (recur 160 | (if (p? v) (inc c) c) 161 | (conj vs v)) 162 | (throw-reader 163 | reader 164 | "%s node expects %d value%s." 165 | node-tag 166 | n 167 | (if (= n 1) "" "s"))) 168 | vs))) 169 | 170 | (defn- re-matches* 171 | [re s] 172 | (let [matches (.exec re s)] 173 | (when (and (not (nil? matches)) 174 | (identical? (aget matches 0) s)) 175 | (if (== (alength matches) 1) 176 | (aget matches 0) 177 | matches)))) 178 | 179 | (defn read-keyword 180 | [^not-native reader initch] 181 | (let [tok (#'cljs.tools.reader/read-token reader :keyword (read-char reader)) 182 | a (re-matches* (re-pattern "^[:]?([^0-9/].*/)?([^0-9/][^/]*)$") tok) 183 | token (aget a 0) 184 | ns (aget a 1) 185 | name (aget a 2)] 186 | (if (or (and (not (undefined? ns)) 187 | (identical? (. ns (substring (- (.-length ns) 2) (.-length ns))) ":/")) 188 | (identical? (aget name (dec (.-length name))) ":") 189 | (not (== (.indexOf token "::" 1) -1))) 190 | (cljs.tools.reader.impl.errors/reader-error reader 191 | "Invalid token: " 192 | token) 193 | (if (and (not (nil? ns)) (> (.-length ns) 0)) 194 | (keyword (.substring ns 0 (.indexOf ns "/")) name) 195 | (keyword (.substring token 1)))))) 196 | 197 | ;; (let [form-rdr (r/indexing-push-back-reader "(+ 1 1)")] 198 | ;; (read-include-linebreak form-rdr)) 199 | 200 | 201 | ;(re-matches* (re-pattern "^[:]?([^0-9/].*/)?([^0-9/][^/]*)$") ":%dill.*") 202 | -------------------------------------------------------------------------------- /src/rewrite_clj/zip.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.zip 2 | "Client facing facade for zipper functions" 3 | (:refer-clojure :exclude [next find replace remove 4 | seq? map? vector? list? set? 5 | print map get assoc]) 6 | (:require [rewrite-clj.zip.base :as base] 7 | [rewrite-clj.parser :as p] 8 | [rewrite-clj.zip.move :as m] 9 | [rewrite-clj.zip.findz :as f] 10 | [rewrite-clj.zip.editz :as ed] 11 | [rewrite-clj.zip.insert :as ins] 12 | [rewrite-clj.zip.removez :as rm] 13 | [rewrite-clj.zip.seqz :as sz] 14 | [clojure.zip :as z])) 15 | 16 | 17 | 18 | (def node 19 | "Function reference to clojure.zip/node" 20 | z/node) 21 | (def root 22 | "Function reference to clojure.zip/root" 23 | z/root) 24 | 25 | 26 | (def of-string 27 | "See [[base/of-string]]" 28 | base/of-string) 29 | (def root-string 30 | "See [[base/root-string]]" 31 | base/root-string) 32 | (def string 33 | "See [[base/string]]" 34 | base/string) 35 | (def tag 36 | "See [[base/tag]]" 37 | base/tag) 38 | (def sexpr 39 | "See [[base/sexpr]]" 40 | base/sexpr) 41 | 42 | 43 | 44 | 45 | ;; ********************************** 46 | ;; Originally in rewrite-clj.zip.move 47 | ;; ********************************** 48 | (def right 49 | "See [[move/right]]" 50 | m/right) 51 | (def left 52 | "See [[move/left]]" 53 | m/left) 54 | (def down 55 | "See [[move/down]]" 56 | m/down) 57 | (def up 58 | "See [[move/up]]" 59 | m/up) 60 | (def next 61 | "See [[move/next]]" 62 | m/next) 63 | (def end? 64 | "See [[move/end?]]" 65 | m/end?) 66 | (def rightmost? 67 | "See [[move/rightmost?]]" 68 | m/rightmost?) 69 | (def leftmost? 70 | "See [[move/leftmost?]]" 71 | m/leftmost?) 72 | (def prev 73 | "See [[move/prev]]" 74 | m/prev) 75 | (def leftmost 76 | "See [[move/leftmost]]" 77 | m/leftmost) 78 | (def rightmost 79 | "See [[move/rightmost]]" 80 | m/rightmost) 81 | 82 | 83 | 84 | ;; ********************************** 85 | ;; Originally in rewrite-clj.zip.findz 86 | ;; ********************************** 87 | (def find 88 | "See [[findz/find]]" 89 | f/find) 90 | (def find-last-by-pos 91 | "See [[findz/find-last-by-pos]]" 92 | f/find-last-by-pos) 93 | (def find-depth-first 94 | "See [[findz/find-depth-first]]" 95 | f/find-depth-first) 96 | (def find-next 97 | "See [[findz/find-next]]" 98 | f/find-next) 99 | (def find-next-depth-first 100 | "See [[findz/find-next-depth-first]]" 101 | f/find-next-depth-first) 102 | (def find-tag 103 | "See [[findz/find-tag]]" 104 | f/find-tag) 105 | (def find-next-tag 106 | "See [[findz/find-next-tag]]" 107 | f/find-next-tag) 108 | (def find-tag-by-pos 109 | "See [[findz/tag-by-pos]]" 110 | f/find-tag-by-pos) 111 | (def find-token 112 | "See [[findz/find-token]]" 113 | f/find-token) 114 | (def find-next-token 115 | "See [[findz/find-next-token]]" 116 | f/find-next-token) 117 | (def find-value 118 | "See [[findz/find-value]]" 119 | f/find-value) 120 | (def find-next-value 121 | "See [[findz/find-next-value]]" 122 | f/find-next-value) 123 | 124 | 125 | 126 | ;; ********************************** 127 | ;; Originally in rewrite-clj.zip.editz 128 | ;; ********************************** 129 | (def replace 130 | "See [[editz/replace]]" 131 | ed/replace) 132 | (def edit 133 | "See [[editz/edit]]" 134 | ed/edit) 135 | (def splice 136 | "See [[editz/splice]]" 137 | ed/splice) 138 | (def prefix 139 | "See [[editz/prefix]]" 140 | ed/prefix) 141 | (def suffix 142 | "See [[editz/suffix]]" 143 | ed/suffix) 144 | 145 | ;; ********************************** 146 | ;; Originally in rewrite-clj.zip.removez 147 | ;; ********************************** 148 | (def remove 149 | "See [[removez/remove]]" 150 | rm/remove) 151 | (def remove-preserve-newline 152 | "See [[removez/remove-preserve-newline]]" 153 | rm/remove-preserve-newline) 154 | 155 | 156 | ;; ********************************** 157 | ;; Originally in rewrite-clj.zip.insert 158 | ;; ********************************** 159 | (def insert-right 160 | "See [[insert/insert-right]]" 161 | ins/insert-right) 162 | (def insert-left 163 | "See [[insert/insert-left]]" 164 | ins/insert-left) 165 | (def insert-child 166 | "See [[insert/insert-child]]" 167 | ins/insert-child) 168 | (def append-child 169 | "See [[insert/append-child]]" 170 | ins/append-child) 171 | 172 | 173 | ;; ********************************** 174 | ;; Originally in rewrite-clj.zip.seqz 175 | ;; ********************************** 176 | (def seq? 177 | "See [[seqz/seq?]]" 178 | sz/seq?) 179 | (def list? 180 | "See [[seqz/list?]]" 181 | sz/list?) 182 | (def vector? 183 | "See [[seqz/vector?]]" 184 | sz/vector?) 185 | (def set? 186 | "See [[seqz/set?]]" 187 | sz/set?) 188 | (def map? 189 | "See [[seqz/map?]]" 190 | sz/map?) 191 | (def map-vals 192 | "See [[seqz/map-vals]]" 193 | sz/map-vals) 194 | (def map-keys 195 | "See [[seqz/map-keys]]" 196 | sz/map-keys) 197 | (def map 198 | "See [[seqz/map]]" 199 | sz/map) 200 | (def get 201 | "See [[seqz/get]]" 202 | sz/get) 203 | (def assoc 204 | "See [[seqz/assoc]]" 205 | sz/assoc) 206 | -------------------------------------------------------------------------------- /src/rewrite_clj/zip/base.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.zip.base 2 | (:refer-clojure :exclude [print]) 3 | (:require [rewrite-clj.node :as node] 4 | [rewrite-clj.parser :as p] 5 | [rewrite-clj.zip.whitespace :as ws] 6 | [clojure.zip :as z])) 7 | 8 | ;; ## Zipper 9 | 10 | (defn edn* 11 | "Create zipper over the given Clojure/EDN node." 12 | [node] 13 | (z/zipper 14 | node/inner? 15 | (comp seq node/children) 16 | node/replace-children 17 | node)) 18 | 19 | (defn edn 20 | "Create zipper over the given Clojure/EDN node and move 21 | to the first non-whitespace/non-comment child." 22 | [node] 23 | (if (= (node/tag node) :forms) 24 | (let [top (edn* node)] 25 | (or (-> top z/down ws/skip-whitespace) 26 | top)) 27 | (recur (node/forms-node [node])))) 28 | 29 | ;; ## Inspection 30 | 31 | (defn tag 32 | "Get tag of node at the current zipper location." 33 | [zloc] 34 | (some-> zloc z/node node/tag)) 35 | 36 | (defn sexpr 37 | "Get sexpr represented by the given node." 38 | [zloc] 39 | (some-> zloc z/node node/sexpr)) 40 | 41 | (defn child-sexprs 42 | "Get children as s-expressions." 43 | [zloc] 44 | (some-> zloc z/node node/child-sexprs)) 45 | 46 | (defn length 47 | "Get length of printable string for the given zipper location." 48 | [zloc] 49 | (or (some-> zloc z/node node/length) 0)) 50 | 51 | 52 | ;; ## Read 53 | 54 | (defn of-string 55 | "Create zipper from String." 56 | [s] 57 | (some-> s p/parse-string-all edn)) 58 | 59 | 60 | ;; ## Write 61 | 62 | (defn string 63 | "Create string representing the current zipper location." 64 | [zloc] 65 | (some-> zloc z/node node/string)) 66 | 67 | (defn root-string 68 | "Create string representing the zipped-up zipper." 69 | [zloc] 70 | (some-> zloc z/root node/string)) 71 | 72 | ;; (defn- print! 73 | ;; [s writer] 74 | ;; (if writer 75 | ;; (.write ^java.io.Writer writer s) 76 | ;; (recur s *out*))) 77 | 78 | ;; (defn print 79 | ;; "Print current zipper location." 80 | ;; [zloc & [writer]] 81 | ;; (some-> zloc 82 | ;; string 83 | ;; (print! writer))) 84 | 85 | ;; (defn print-root 86 | ;; "Zip up and print root node." 87 | ;; [zloc & [writer]] 88 | ;; (some-> zloc 89 | ;; root-string 90 | ;; (print! writer))) 91 | -------------------------------------------------------------------------------- /src/rewrite_clj/zip/editz.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.zip.editz 2 | (:refer-clojure :exclude [replace]) 3 | (:require [rewrite-clj.zip.base :as base] 4 | [rewrite-clj.zip.move :as m] 5 | [rewrite-clj.zip.removez :as r] 6 | [rewrite-clj.zip.utils :as u] 7 | [rewrite-clj.zip.whitespace :as ws] 8 | [rewrite-clj.node :as n] 9 | [clojure.zip :as z])) 10 | 11 | ;; ## In-Place Modification 12 | 13 | (defn replace 14 | "Replace the node at the given location with one representing 15 | the given value. (The value will be coerced to a node if 16 | possible.)" 17 | [zloc value] 18 | (z/replace zloc (n/coerce value))) 19 | 20 | (defn- edit-node 21 | "Create s-expression from node, apply the function and create 22 | node from the result." 23 | [node f] 24 | (-> (n/sexpr node) 25 | (f) 26 | (n/coerce))) 27 | 28 | (defn edit 29 | "Apply the given function to the s-expression at the given 30 | location, using its result to replace the node there. (The 31 | result will be coerced to a node if possible.)" 32 | [zloc f & args] 33 | (z/edit zloc edit-node #(apply f % args))) 34 | 35 | ;; ## Splice 36 | 37 | 38 | 39 | (defn splice 40 | "Splice the given node, i.e. merge its children into the current one 41 | (akin to Clojure's `unquote-splicing` macro: `~@...`). 42 | - if the node is not one that can have children, no modification will 43 | be performed. 44 | - if the node has no or only whitespace children, it will be removed. 45 | - otherwise, splicing will be performed, moving the zipper to the first 46 | non-whitespace child afterwards. 47 | " 48 | [zloc] 49 | (if (z/branch? zloc) 50 | (if-let [children (->> (z/children zloc) 51 | (drop-while n/whitespace?) 52 | (reverse) 53 | (drop-while n/whitespace?) 54 | (seq))] 55 | (let [loc (->> (reduce z/insert-right zloc children) 56 | (u/remove-and-move-right))] 57 | (or (ws/skip-whitespace loc) loc)) 58 | (r/remove zloc)) 59 | zloc)) 60 | 61 | ;; ## Prefix/Suffix 62 | 63 | (defn- edit-token 64 | [zloc str-fn] 65 | (let [e (base/sexpr zloc) 66 | e' (cond (string? e) (str-fn e) 67 | (keyword? e) (keyword (namespace e) (str-fn (name e))) 68 | (symbol? e) (symbol (namespace e) (str-fn (name e))))] 69 | (z/replace zloc (n/token-node e')))) 70 | 71 | (defn- edit-multi-line 72 | [zloc line-fn] 73 | (let [n (-> (z/node zloc) 74 | (update-in [:lines] (comp line-fn vec)))] 75 | (z/replace zloc n))) 76 | 77 | (defn prefix 78 | [zloc s] 79 | (case (base/tag zloc) 80 | :token (edit-token zloc #(str s %)) 81 | :multi-line (->> (fn [lines] 82 | (if (empty? lines) 83 | [s] 84 | (update-in lines [0] #(str s %)))) 85 | (edit-multi-line zloc )))) 86 | 87 | (defn suffix 88 | [zloc s] 89 | (case (base/tag zloc) 90 | :token (edit-token zloc #(str % s)) 91 | :multi-line (->> (fn [lines] 92 | (if (empty? lines) 93 | [s] 94 | (concat (butlast lines) (str (last lines) s)))) 95 | (edit-multi-line zloc)))) 96 | -------------------------------------------------------------------------------- /src/rewrite_clj/zip/findz.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.zip.findz 2 | (:refer-clojure :exclude [find]) 3 | (:require [rewrite-clj.zip.base :as base] 4 | [rewrite-clj.zip.move :as m] 5 | [rewrite-clj.node :as node] 6 | [rewrite-clj.zip.whitespace :as ws] 7 | [clojure.zip :as z])) 8 | 9 | ;; ## Helpers 10 | 11 | (defn- tag-predicate 12 | [t & [additional]] 13 | (if additional 14 | (fn [node] 15 | (and (= (base/tag node) t) 16 | (additional node))) 17 | #(= (base/tag %) t))) 18 | 19 | 20 | (defn in-range? [{:keys [row col end-row end-col]} {r :row c :col}] 21 | (and (>= r row) 22 | (<= r end-row) 23 | (if (= r row) (>= c col) true) 24 | (if (= r end-row) (<= c end-col) true))) 25 | 26 | 27 | ;; ## Find Operations 28 | 29 | (defn find 30 | "Find node satisfying the given predicate by repeatedly 31 | applying the given movement function to the initial zipper 32 | location." 33 | ([zloc p?] 34 | (find zloc m/right p?)) 35 | ([zloc f p?] 36 | (->> zloc 37 | (iterate f) 38 | (take-while identity) 39 | (take-while (complement m/end?)) 40 | (drop-while (complement p?)) 41 | (first)))) 42 | 43 | 44 | 45 | (defn find-last-by-pos 46 | "Find last node (if more than one node) that is in range of pos and 47 | satisfying the given predicate depth first from initial zipper 48 | location." 49 | ([zloc pos] (find-last-by-pos zloc pos (constantly true))) 50 | ([zloc pos p?] 51 | (->> zloc 52 | (iterate z/next) 53 | (take-while identity) 54 | (take-while (complement m/end?)) 55 | (filter #(and (p? %) 56 | (in-range? (-> % z/node meta) pos))) 57 | last))) 58 | 59 | 60 | (defn find-depth-first 61 | "Find node satisfying the given predicate by traversing 62 | the zipper in a depth-first way." 63 | [zloc p?] 64 | (find zloc m/next p?)) 65 | 66 | 67 | (defn find-next 68 | "Find node other than the current zipper location matching 69 | the given predicate by applying the given movement function 70 | to the initial zipper location." 71 | ([zloc p?] 72 | (find-next zloc m/right p?)) 73 | ([zloc f p?] 74 | (some-> zloc f (find f p?)))) 75 | 76 | (defn find-next-depth-first 77 | "Find node other than the current zipper location matching 78 | the given predicate by traversing the zipper in a 79 | depth-first way." 80 | [zloc p?] 81 | (find-next zloc m/next p?)) 82 | 83 | (defn find-tag 84 | "Find node with the given tag by repeatedly applying the given 85 | movement function to the initial zipper location." 86 | ([zloc t] 87 | (find-tag zloc m/right t)) 88 | ([zloc f t] 89 | (find zloc f #(= (base/tag %) t)))) 90 | 91 | (defn find-next-tag 92 | "Find node other than the current zipper location with the 93 | given tag by repeatedly applying the given movement function to 94 | the initial zipper location." 95 | ([zloc t] 96 | (find-next-tag zloc m/right t)) 97 | ([zloc f t] 98 | (->> (tag-predicate t) 99 | (find-next zloc f)))) 100 | 101 | 102 | (defn find-tag-by-pos 103 | "Find node with the given tag and pos depth-first from initial zipper location." 104 | ([zloc pos t] 105 | (find-last-by-pos zloc pos #(= (base/tag %) t)))) 106 | 107 | 108 | 109 | (defn find-token 110 | "Find token node matching the given predicate by applying the 111 | given movement function to the initial zipper location, defaulting 112 | to `right`." 113 | ([zloc p?] 114 | (find-token zloc m/right p?)) 115 | ([zloc f p?] 116 | (->> (tag-predicate :token p?) 117 | (find zloc f)))) 118 | 119 | (defn find-next-token 120 | "Find next token node matching the given predicate by applying the 121 | given movement function to the initial zipper location, defaulting 122 | to `right`." 123 | ([zloc p?] 124 | (find-next-token zloc m/right p?)) 125 | ([zloc f p?] 126 | (find-token (f zloc) f p?))) 127 | 128 | (defn find-value 129 | "Find token node whose value matches the given one by applying the 130 | given movement function to the initial zipper location, defaulting 131 | to `right`." 132 | ([zloc v] 133 | (find-value zloc m/right v)) 134 | ([zloc f v] 135 | (let [p? (if (set? v) 136 | (comp v base/sexpr) 137 | #(= (base/sexpr %) v))] 138 | (find-token zloc f p?)))) 139 | 140 | (defn find-next-value 141 | "Find next token node whose value matches the given one by applying the 142 | given movement function to the initial zipper location, defaulting 143 | to `right`." 144 | ([zloc v] 145 | (find-next-value zloc m/right v)) 146 | ([zloc f v] 147 | (find-value (f zloc) f v))) 148 | -------------------------------------------------------------------------------- /src/rewrite_clj/zip/insert.cljs: -------------------------------------------------------------------------------- 1 | (ns ^:no-doc rewrite-clj.zip.insert 2 | (:require [rewrite-clj.zip.base :as base] 3 | [rewrite-clj.zip.whitespace :as ws] 4 | [rewrite-clj.node :as node] 5 | [clojure.zip :as z])) 6 | 7 | (def ^:private space 8 | (node/spaces 1)) 9 | 10 | (defn- insert 11 | "Generic insertion helper. If the node reached by `move-fn` 12 | is a whitespace, insert an additional space." 13 | [move-fn insert-fn prefix zloc item] 14 | (let [item-node (node/coerce item) 15 | next-node (move-fn zloc)] 16 | (->> (if (or (not next-node) (ws/whitespace? next-node)) 17 | (concat [item-node] prefix) 18 | (concat [space item-node] prefix)) 19 | (reduce insert-fn zloc)))) 20 | 21 | (defn insert-right 22 | "Insert item to the right of the current location. Will insert a space if necessary." 23 | [zloc item] 24 | (insert 25 | z/right 26 | z/insert-right 27 | [space] 28 | zloc item)) 29 | 30 | (defn insert-left 31 | "Insert item to the right of the left location. Will insert a space if necessary." 32 | [zloc item] 33 | (insert 34 | z/left 35 | z/insert-left 36 | [space] 37 | zloc item)) 38 | 39 | (defn insert-child 40 | "Insert item as first child of the current node. Will insert a space if necessary." 41 | [zloc item] 42 | (insert 43 | z/down 44 | z/insert-child 45 | [] 46 | zloc item)) 47 | 48 | (defn append-child 49 | "Insert item as last child of the current node. Will insert a space if necessary." 50 | [zloc item] 51 | (insert 52 | #(some-> % z/down z/rightmost) 53 | z/append-child 54 | [] 55 | zloc item)) 56 | -------------------------------------------------------------------------------- /src/rewrite_clj/zip/move.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.zip.move 2 | (:refer-clojure :exclude [next]) 3 | (:require [rewrite-clj.zip.whitespace :as ws] 4 | [clojure.zip :as z])) 5 | 6 | (defn right 7 | "Move right to next non-whitespace/non-comment location." 8 | [zloc] 9 | (some-> zloc z/right ws/skip-whitespace)) 10 | 11 | (defn left 12 | "Move left to next non-whitespace/non-comment location." 13 | [zloc] 14 | (some-> zloc z/left ws/skip-whitespace-left)) 15 | 16 | (defn down 17 | "Move down to next non-whitespace/non-comment location." 18 | [zloc] 19 | (some-> zloc z/down ws/skip-whitespace)) 20 | 21 | (defn up 22 | "Move up to next non-whitespace/non-comment location." 23 | [zloc] 24 | (some-> zloc z/up ws/skip-whitespace-left)) 25 | 26 | (defn next 27 | "Move to the next non-whitespace/non-comment location in a depth-first manner." 28 | [zloc] 29 | (when zloc 30 | (or (some->> zloc 31 | z/next 32 | (ws/skip-whitespace z/next)) 33 | (vary-meta zloc assoc ::end? true)))) 34 | 35 | (defn end? 36 | "Check whether the given node is at the end of the depth-first traversal." 37 | [zloc] 38 | (or (not zloc) 39 | (z/end? zloc) 40 | (::end? (meta zloc)))) 41 | 42 | (defn rightmost? 43 | "Check if the given location represents the leftmost non-whitespace/ 44 | non-comment one." 45 | [zloc] 46 | (nil? (ws/skip-whitespace (z/right zloc)))) 47 | 48 | (defn leftmost? 49 | "Check if the given location represents the leftmost non-whitespace/ 50 | non-comment one." 51 | [zloc] 52 | (nil? (ws/skip-whitespace-left (z/left zloc)))) 53 | 54 | (defn prev 55 | "Move to the next non-whitespace/non-comment location in a depth-first manner." 56 | [zloc] 57 | (some->> zloc 58 | z/prev 59 | (ws/skip-whitespace z/prev))) 60 | 61 | (defn leftmost 62 | "Move to the leftmost non-whitespace/non-comment location." 63 | [zloc] 64 | (some-> zloc 65 | z/leftmost 66 | ws/skip-whitespace)) 67 | 68 | (defn rightmost 69 | "Move to the rightmost non-whitespace/non-comment location." 70 | [zloc] 71 | (some-> zloc 72 | z/rightmost 73 | ws/skip-whitespace-left)) 74 | -------------------------------------------------------------------------------- /src/rewrite_clj/zip/removez.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.zip.removez 2 | (:refer-clojure :exclude [remove]) 3 | (:require [rewrite-clj.zip.move :as m] 4 | [rewrite-clj.zip.utils :as u] 5 | [rewrite-clj.zip.whitespace :as ws] 6 | [clojure.zip :as z])) 7 | 8 | 9 | (defn- remove-trailing-space 10 | "Remove all whitespace following a given node." 11 | [zloc p?] 12 | (u/remove-right-while zloc p?)) 13 | 14 | (defn- remove-preceding-space 15 | "Remove all whitespace preceding a given node." 16 | [zloc p?] 17 | (u/remove-left-while zloc p?)) 18 | 19 | (defn remove 20 | "Remove value at the given zipper location. Returns the first non-whitespace 21 | node that would have preceded it in a depth-first walk. Will remove whitespace 22 | appropriately. 23 | 24 | - `[1 2 3] => [1 3]` 25 | - `[1 2] => [1]` 26 | - `[1 2] => [2]` 27 | - `[1] => []` 28 | - `[ 1 ] => []` 29 | - `[1 [2 3] 4] => [1 [2 3]]` 30 | - `[1 [2 3] 4] => [[2 3] 4]` 31 | 32 | If a node is located rightmost, both preceding and trailing spaces are removed, 33 | otherwise only trailing spaces are touched. This means that a following element 34 | (no matter whether on the same line or not) will end up in the same position 35 | (line/column) as the removed one, _unless_ a comment lies between the original 36 | node and the neighbour." 37 | [zloc] 38 | {:pre [zloc] 39 | :post [%]} 40 | (->> (-> (if (or (m/rightmost? zloc) 41 | (m/leftmost? zloc)) 42 | (remove-preceding-space zloc ws/whitespace?) 43 | zloc) 44 | (remove-trailing-space ws/whitespace?) 45 | z/remove) 46 | (ws/skip-whitespace z/prev))) 47 | 48 | (defn remove-preserve-newline 49 | "Same as remove but preserves newlines" 50 | [zloc] 51 | {:pre [zloc] 52 | :post [%]} 53 | (->> (-> (if (or (m/rightmost? zloc) 54 | (m/leftmost? zloc)) 55 | (remove-preceding-space zloc #(and (ws/whitespace? %) 56 | (not (ws/linebreak? %)))) 57 | zloc) 58 | (remove-trailing-space #(and (ws/whitespace? %) 59 | (not (ws/linebreak? %)))) 60 | z/remove) 61 | (ws/skip-whitespace z/prev))) 62 | 63 | -------------------------------------------------------------------------------- /src/rewrite_clj/zip/seqz.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.zip.seqz 2 | (:refer-clojure :exclude [map get assoc seq? vector? list? map? set?]) 3 | (:require [rewrite-clj.zip.base :as base] 4 | [rewrite-clj.zip.editz :as e] 5 | [rewrite-clj.zip.findz :as f] 6 | [rewrite-clj.zip.insert :as i] 7 | [rewrite-clj.zip.move :as m] 8 | [clojure.zip :as z])) 9 | 10 | ;; ## Predicates 11 | 12 | (defn seq? 13 | [zloc] 14 | (contains? 15 | #{:forms :list :vector :set :map} 16 | (base/tag zloc))) 17 | 18 | (defn list? 19 | [zloc] 20 | (= (base/tag zloc) :list)) 21 | 22 | (defn vector? 23 | [zloc] 24 | (= (base/tag zloc) :vector)) 25 | 26 | (defn set? 27 | [zloc] 28 | (= (base/tag zloc) :set)) 29 | 30 | (defn map? 31 | [zloc] 32 | (= (base/tag zloc) :map)) 33 | 34 | ;; ## Map Operations 35 | 36 | (defn- map-seq 37 | [f zloc] 38 | {:pre [(seq? zloc)]} 39 | (if-let [n0 (m/down zloc)] 40 | (some->> (f n0) 41 | (iterate 42 | (fn [loc] 43 | (if-let [n (m/right loc)] 44 | (f n)))) 45 | (take-while identity) 46 | (last) 47 | (m/up)) 48 | zloc)) 49 | 50 | (defn map-vals 51 | "Apply function to all value nodes of the given map node." 52 | [f zloc] 53 | {:pre [(map? zloc)]} 54 | (loop [loc (m/down zloc) 55 | parent zloc] 56 | (if-not (and loc (z/node loc)) 57 | parent 58 | (if-let [v0 (m/right loc)] 59 | (if-let [v (f v0)] 60 | (recur (m/right v) (m/up v)) 61 | (recur (m/right v0) parent)) 62 | parent)))) 63 | 64 | (defn map-keys 65 | "Apply function to all key nodes of the given map node." 66 | [f zloc] 67 | {:pre [(map? zloc)]} 68 | (loop [loc (m/down zloc) 69 | parent zloc] 70 | (if-not (and loc (z/node loc)) 71 | parent 72 | (if-let [v (f loc)] 73 | (recur (m/right (m/right v)) (m/up v)) 74 | (recur (m/right (m/right loc)) parent))))) 75 | 76 | (defn map 77 | "Apply function to all value nodes in the given seq node. Iterates over 78 | value nodes of maps but over each element of a seq." 79 | [f zloc] 80 | {:pre [(seq? zloc)]} 81 | (if (map? zloc) 82 | (map-vals f zloc) 83 | (map-seq f zloc))) 84 | 85 | ;; ## Get/Assoc 86 | 87 | (defn get 88 | "If a map is given, get element with the given key; if a seq is given, get nth element." 89 | [zloc k] 90 | {:pre [(or (map? zloc) (and (seq? zloc) (integer? k)))]} 91 | (if (map? zloc) 92 | (some-> zloc m/down (f/find-value k) m/right) 93 | (nth 94 | (some->> (m/down zloc) 95 | (iterate m/right) 96 | (take-while identity)) 97 | k))) 98 | 99 | (defn assoc 100 | "Set map/seq element to the given value." 101 | [zloc k v] 102 | (if-let [vloc (get zloc k)] 103 | (-> vloc (e/replace v) m/up) 104 | (if (map? zloc) 105 | (-> zloc 106 | (i/append-child k) 107 | (i/append-child v)) 108 | (throw 109 | (js/Error. 110 | (str "index out of bounds: " k)))))) 111 | -------------------------------------------------------------------------------- /src/rewrite_clj/zip/utils.cljs: -------------------------------------------------------------------------------- 1 | (ns ^:no-doc rewrite-clj.zip.utils 2 | (:require [clojure.zip :as z])) 3 | 4 | ;; ## Remove 5 | 6 | (defn- update-in-path 7 | [[node path :as loc] k f] 8 | (let [v (get path k)] 9 | (if (seq v) 10 | (with-meta 11 | [node (assoc path k (f v) :changed? true)] 12 | (meta loc)) 13 | loc))) 14 | 15 | (defn remove-right 16 | "Remove right sibling of the current node (if there is one)." 17 | [loc] 18 | (update-in-path loc :r next)) 19 | 20 | (defn remove-left 21 | "Remove left sibling of the current node (if there is one)." 22 | [loc] 23 | (update-in-path loc :l pop)) 24 | 25 | 26 | (defn remove-while 27 | [zloc p?] 28 | "Remove nodes while predicate true. (depth first in reverse!) " 29 | (loop [zloc zloc] 30 | (let [ploc (z/prev zloc)] 31 | (if-not (and ploc (p? ploc)) 32 | zloc 33 | (recur (z/remove zloc)))))) 34 | 35 | (defn remove-right-while 36 | "Remove elements to the right of the current zipper location as long as 37 | the given predicate matches." 38 | [zloc p?] 39 | (loop [zloc zloc] 40 | (if-let [rloc (z/right zloc)] 41 | (if (p? rloc) 42 | (recur (remove-right zloc)) 43 | zloc) 44 | zloc))) 45 | 46 | (defn remove-left-while 47 | "Remove elements to the left of the current zipper location as long as 48 | the given predicate matches." 49 | [zloc p?] 50 | (loop [zloc zloc] 51 | (if-let [lloc (z/left zloc)] 52 | (if (p? lloc) 53 | (recur (remove-left zloc)) 54 | zloc) 55 | zloc))) 56 | 57 | ;; ## Remove and Move 58 | 59 | (defn remove-and-move-left 60 | "Remove current node and move left. If current node is at the leftmost 61 | location, returns `nil`." 62 | [[_ {:keys [l] :as path} :as loc]] 63 | (if (seq l) 64 | (with-meta 65 | [(peek l) (-> path 66 | (update-in [:l] pop) 67 | (assoc :changed? true))] 68 | (meta loc)))) 69 | 70 | (defn remove-and-move-right 71 | "Remove current node and move right. If current node is at the rightmost 72 | location, returns `nil`." 73 | [[_ {:keys [r] :as path} :as loc]] 74 | (if (seq r) 75 | (with-meta 76 | [(first r) (-> path 77 | (update-in [:r] next) 78 | (assoc :changed? true))] 79 | (meta loc)))) 80 | 81 | 82 | (defn remove-and-move-up [loc] 83 | (let [[node {l :l, ppath :ppath, pnodes :pnodes, rs :r, :as path}] loc] 84 | (if (nil? path) 85 | (throw (js/Error. "Remove at top")) 86 | (if (pos? (count l)) 87 | (z/up (with-meta [(peek l) 88 | (assoc path :l (pop l) :changed? true)] 89 | (meta loc))) 90 | (with-meta [(z/make-node loc (peek pnodes) rs) 91 | (and ppath (assoc ppath :changed? true))] 92 | (meta loc)))))) 93 | 94 | -------------------------------------------------------------------------------- /src/rewrite_clj/zip/whitespace.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.zip.whitespace 2 | (:require [rewrite-clj.node :as node] 3 | [clojure.zip :as z])) 4 | 5 | ;; ## Predicates 6 | 7 | (defn whitespace? 8 | [zloc] 9 | (some-> zloc z/node node/whitespace?)) 10 | 11 | (defn linebreak? 12 | [zloc] 13 | (some-> zloc z/node node/linebreak?)) 14 | 15 | (defn comment? 16 | [zloc] 17 | (some-> zloc z/node node/comment?)) 18 | 19 | (defn whitespace-not-linebreak? 20 | [zloc] 21 | (and 22 | (whitespace? zloc) 23 | (not (linebreak? zloc)))) 24 | 25 | (defn whitespace-or-comment? 26 | [zloc] 27 | (some-> zloc z/node node/whitespace-or-comment?)) 28 | 29 | 30 | ;; ## Movement 31 | 32 | (defn skip 33 | "Perform the given movement while the given predicate returns true." 34 | [f p? zloc] 35 | (->> (iterate f zloc) 36 | (take-while identity) 37 | (take-while (complement z/end?)) 38 | (drop-while p?) 39 | (first))) 40 | 41 | (defn skip-whitespace 42 | "Perform the given movement (default: `z/right`) until a non-whitespace/ 43 | non-comment node is encountered." 44 | ([zloc] (skip-whitespace z/right zloc)) 45 | ([f zloc] (skip f whitespace-or-comment? zloc))) 46 | 47 | (defn skip-whitespace-left 48 | "Move left until a non-whitespace/non-comment node is encountered." 49 | [zloc] 50 | (skip-whitespace z/left zloc)) 51 | 52 | ;; ## Insertion 53 | 54 | (defn prepend-space 55 | "Prepend a whitespace node representing the given number of spaces (default: 1)." 56 | ([zloc] (prepend-space zloc 1)) 57 | ([zloc n] 58 | (z/insert-left zloc (node/spaces n)))) 59 | 60 | (defn append-space 61 | "Append a whitespace node representing the given number of spaces (default: 1)." 62 | ([zloc] (append-space zloc 1)) 63 | ([zloc n] 64 | (z/insert-right zloc (node/spaces n)))) 65 | 66 | (defn prepend-newline 67 | "Prepend a newlines node representing the given number of newlines (default: 1)." 68 | ([zloc] (prepend-newline zloc 1)) 69 | ([zloc n] 70 | (z/insert-left zloc (node/newlines n)))) 71 | 72 | (defn append-newline 73 | "Append a newline node representing the given number of newlines (default: 1)." 74 | ([zloc] (append-newline zloc 1)) 75 | ([zloc n] 76 | (z/insert-right zloc (node/newlines n)))) 77 | -------------------------------------------------------------------------------- /test/rewrite_clj/node_test.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.node-test 2 | (:require [cljs.test :refer-macros [deftest is testing run-tests]] 3 | [rewrite-clj.node :as n] 4 | [rewrite-clj.parser :as p])) 5 | 6 | 7 | (deftest namespaced-keyword 8 | (is (= ":dill/dall" 9 | (n/string (n/keyword-node :dill/dall))))) 10 | 11 | (deftest funky-keywords 12 | (is (= ":%dummy.*" 13 | (n/string (n/keyword-node :%dummy.*))))) 14 | 15 | (deftest regex-node 16 | (let [sample "(re-find #\"(?i)RUN\" s)" 17 | sample2 "(re-find #\"(?m)^rss\\s+(\\d+)$\")" 18 | sample3 "(->> (str/split container-name #\"/\"))"] 19 | (is (= sample (-> sample p/parse-string n/string))) 20 | (is (= sample2 (-> sample2 p/parse-string n/string))) 21 | (is (= sample3 (-> sample3 p/parse-string n/string))))) 22 | 23 | 24 | (deftest regex-with-newlines 25 | (let [sample "(re-find #\"Hello 26 | \\nJalla\")"] 27 | (is (= sample (-> sample p/parse-string n/string))))) 28 | 29 | 30 | 31 | (deftest reader-conditionals 32 | (testing "Simple reader conditional" 33 | (let [sample "#?(:clj bar)" 34 | res (p/parse-string sample)] 35 | (is (= sample (n/string res))) 36 | (is (= :reader-macro (n/tag res))) 37 | (is (= [:token :list] (map n/tag (n/children res)))))) 38 | 39 | (testing "Reader conditional with space before list" 40 | (let [sample "#? (:clj bar)" 41 | sample2 "#?@ (:clj bar)"] 42 | (is (= sample (-> sample p/parse-string n/string))) 43 | (is (= sample2 (-> sample2 p/parse-string n/string))))) 44 | 45 | 46 | (testing "Reader conditional with splice" 47 | (let [sample 48 | "(:require [clojure.string :as s] 49 | #?@(:clj [[clj-time.format :as tf] 50 | [clj-time.coerce :as tc]] 51 | :cljs [[cljs-time.coerce :as tc] 52 | [cljs-time.format :as tf]]))" 53 | res (p/parse-string sample)] 54 | (is (= sample (n/string res)))))) 55 | 56 | -------------------------------------------------------------------------------- /test/rewrite_clj/paredit_test.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.paredit-test 2 | (:require [cljs.test :refer-macros [deftest is testing run-tests]] 3 | [rewrite-clj.zip :as z] 4 | [clojure.zip :as zz] 5 | [rewrite-clj.paredit :as pe])) 6 | 7 | 8 | 9 | ;; helper 10 | (defn move-n [loc f n] 11 | (->> loc (iterate f) (take n) last)) 12 | 13 | 14 | (deftest kill-to-end-of-sexpr 15 | (let [res (-> "[1 2 3 4]" 16 | z/of-string 17 | z/down zz/right 18 | pe/kill)] 19 | (is (= "[1]" (-> res z/root-string))) 20 | (is (= "1" (-> res z/string))))) 21 | 22 | (deftest kill-to-end-of-line 23 | (let [res (-> "[1 2] ; useless comment" 24 | z/of-string 25 | zz/right 26 | pe/kill)] 27 | (is (= "[1 2]" (-> res z/root-string))) 28 | (is (= "[1 2]" (-> res z/string))))) 29 | 30 | (deftest kill-to-wipe-all-sexpr-contents 31 | (let [res (-> "[1 2 3 4]" 32 | z/of-string 33 | z/down 34 | pe/kill)] 35 | (is (= "[]" (-> res z/root-string))) 36 | (is (= "[]" (-> res z/string))))) 37 | 38 | (deftest kill-to-wipe-all-sexpr-contents-in-nested-seq 39 | (let [res (-> "[[1 2 3 4]]" 40 | z/of-string 41 | z/down 42 | pe/kill)] 43 | (is (= "[]" (-> res z/root-string))) 44 | (is (= "[]" (-> res z/string))))) 45 | 46 | (deftest kill-when-left-is-sexpr 47 | (let [res (-> "[1 2 3 4] 2" 48 | z/of-string 49 | zz/right 50 | pe/kill)] 51 | (is (= "[1 2 3 4]" (-> res z/root-string))) 52 | (is (= "[1 2 3 4]" (-> res z/string))))) 53 | 54 | (deftest kill-it-all 55 | (let [res (-> "[1 2 3 4] 5" 56 | z/of-string 57 | pe/kill)] 58 | (is (= "" (-> res z/root-string))) 59 | (is (= "" (-> res z/string))))) 60 | 61 | 62 | 63 | (deftest kill-at-pos-when-in-empty-seq 64 | (let [res (-> "[] 5" 65 | z/of-string 66 | (pe/kill-at-pos {:row 1 :col 2}))] 67 | (is (= "5" (-> res z/root-string))) 68 | (is (= "5" (-> res z/string))))) 69 | 70 | 71 | (deftest kill-inside-comment 72 | (is (= "; dill" (-> "; dilldall" 73 | z/of-string 74 | (pe/kill-at-pos {:row 1 :col 7}) 75 | z/root-string)))) 76 | 77 | (deftest kill-at-pos-when-string 78 | (let [res (-> "(str \"Hello \" \"World!\")" 79 | z/of-string 80 | z/down 81 | (pe/kill-at-pos {:row 1 :col 9}))] 82 | (is (= "(str \"He\" \"World!\")" (-> res z/root-string))))) 83 | 84 | 85 | (deftest kill-at-pos-when-string-multiline 86 | (let [sample "(str \" 87 | First line 88 | Second Line 89 | Third Line 90 | \")" 91 | expected "(str \" 92 | First line 93 | Second\")" 94 | 95 | res (-> sample 96 | z/of-string 97 | z/down 98 | (pe/kill-at-pos {:row 3 :col 9}))] 99 | (is (= expected (-> res z/root-string))))) 100 | 101 | 102 | 103 | 104 | (deftest kill-at-pos-multiline-aligned 105 | (let [sample " 106 | (println \"Hello 107 | There 108 | World\")"] 109 | (is (= "\n(println \"Hello\")" (-> sample 110 | z/of-string 111 | (pe/kill-at-pos {:row 2 :col 16}) 112 | (z/root-string)))))) 113 | 114 | 115 | 116 | (deftest kill-at-pos-when-empty-string 117 | (is (= "" (-> (z/of-string "\"\"") (pe/kill-at-pos {:row 1 :col 1}) z/root-string)))) 118 | 119 | 120 | 121 | (deftest kill-one-at-pos 122 | (let [sample "[10 20 30]"] 123 | (is (= "[10 30]" 124 | (-> (z/of-string sample) 125 | (pe/kill-one-at-pos {:row 1 :col 4}) ; at whitespace 126 | z/root-string))) 127 | (is (= "[10 30]" 128 | (-> (z/of-string sample) 129 | (pe/kill-one-at-pos {:row 1 :col 5}) 130 | z/root-string))))) 131 | 132 | (deftest kill-one-at-pos-new-zloc-is-left-node 133 | (let [sample "[[10] 20 30]"] 134 | (is (= "[10]" 135 | (-> (z/of-string sample) 136 | (pe/kill-one-at-pos {:row 1 :col 6}) 137 | z/string))) 138 | (is (= "[10]" 139 | (-> (z/of-string sample) 140 | (pe/kill-one-at-pos {:row 1 :col 7}) 141 | z/string))))) 142 | 143 | (deftest kill-one-at-pos-keep-linebreaks 144 | (let [sample (z/of-string "[10\n 20\n 30]")] 145 | (is (= "[20\n 30]" 146 | (-> sample (pe/kill-one-at-pos {:row 1 :col 2}) z/root-string))) 147 | (is (= "[10\n 30]" 148 | (-> sample (pe/kill-one-at-pos {:row 2 :col 1}) z/root-string))) 149 | (is (= "[10\n 20]" 150 | (-> sample (pe/kill-one-at-pos {:row 3 :col 1}) z/root-string))))) 151 | 152 | (deftest kill-one-at-pos-in-comment 153 | (let [sample (z/of-string "; hello world")] 154 | (is (= "; hello " 155 | (-> (pe/kill-one-at-pos sample {:row 1 :col 8}) z/root-string))) 156 | (is (= "; hello " 157 | (-> (pe/kill-one-at-pos sample {:row 1 :col 9}) z/root-string))) 158 | (is (= "; hello " 159 | (-> (pe/kill-one-at-pos sample {:row 1 :col 13}) z/root-string))) 160 | (is (= "; world" 161 | (-> (pe/kill-one-at-pos sample {:row 1 :col 2}) z/root-string))))) 162 | 163 | (deftest kill-one-at-pos-in-string 164 | (let [sample (z/of-string "\"hello world\"")] 165 | (is (= "\"hello \"" 166 | (-> (pe/kill-one-at-pos sample {:row 1 :col 7}) z/root-string))) 167 | (is (= "\"hello \"" 168 | (-> (pe/kill-one-at-pos sample {:row 1 :col 8}) z/root-string))) 169 | (is (= "\"hello \"" 170 | (-> (pe/kill-one-at-pos sample {:row 1 :col 12}) z/root-string))) 171 | (is (= "\" world\"" 172 | (-> (pe/kill-one-at-pos sample {:row 1 :col 2}) z/root-string))))) 173 | 174 | 175 | (deftest kill-one-at-pos-in-multiline-string 176 | (let [sample (z/of-string "\"foo bar do\n lorem\"")] 177 | (is (= "\" bar do\n lorem\"" 178 | (-> (pe/kill-one-at-pos sample {:row 1 :col 2}) z/root-string))) 179 | (is (= "\"foo bar do\n \"" 180 | (-> (pe/kill-one-at-pos sample {:row 2 :col 1}) z/root-string))) 181 | (is (= "\"foo bar \n lorem\"" 182 | (-> (pe/kill-one-at-pos sample {:row 1 :col 10}) z/root-string))))) 183 | 184 | 185 | 186 | (deftest slurp-forward-and-keep-loc-rightmost 187 | (let [res (-> "[[1 2] 3 4]" 188 | z/of-string 189 | z/down z/down z/right 190 | pe/slurp-forward)] 191 | (is (= "[[1 2 3] 4]" (-> res z/root-string))) 192 | (is (= "2" (-> res z/string))))) 193 | 194 | (deftest slurp-forward-and-keep-loc-leftmost 195 | (let [res (-> "[[1 2] 3 4]" 196 | z/of-string 197 | z/down z/down 198 | pe/slurp-forward)] 199 | (is (= "[[1 2 3] 4]" (-> res z/root-string))) 200 | (is (= "1" (-> res z/string))))) 201 | 202 | (deftest slurp-forward-from-empty-sexpr 203 | (let [res (-> "[[] 1 2 3]" 204 | z/of-string 205 | z/down 206 | pe/slurp-forward)] 207 | (is (= "[[1] 2 3]" (-> res z/root-string))) 208 | (is (= "1" (-> res z/string))))) 209 | 210 | (deftest slurp-forward-from-whitespace-node 211 | (let [res (-> "[[1 2] 3 4]" 212 | z/of-string 213 | z/down z/down zz/right 214 | pe/slurp-forward)] 215 | (is (= "[[1 2 3] 4]" (-> res z/root-string))) 216 | (is (= " " (-> res z/string))))) 217 | 218 | (deftest slurp-forward-nested 219 | (let [res (-> "[[[1 2]] 3 4]" 220 | z/of-string 221 | z/down z/down z/down 222 | pe/slurp-forward)] 223 | (is (= "[[[1 2] 3] 4]" (-> res z/root-string))) 224 | (is (= "1" (-> res z/string))))) 225 | 226 | (deftest slurp-forward-nested-silly 227 | (let [res (-> "[[[[[1 2]]]] 3 4]" 228 | z/of-string 229 | z/down z/down z/down z/down z/down 230 | pe/slurp-forward)] 231 | (is (= "[[[[[1 2]]] 3] 4]" (-> res z/root-string))) 232 | (is (= "1" (-> res z/string))))) 233 | 234 | (deftest slurp-forward-when-last-is-sexpr 235 | (let [res (-> "[1 [2 [3 4]] 5]" 236 | z/of-string 237 | z/down z/right z/down ;at 2 238 | pe/slurp-forward)] 239 | (is (= "[1 [2 [3 4] 5]]" (-> res z/root-string)) 240 | (= "2" (-> res z/string))))) 241 | 242 | (deftest slurp-forward-keep-linebreak 243 | (let [sample " 244 | (let [dill] 245 | {:a 1} 246 | {:b 2})" 247 | expected "\n(let [dill \n{:a 1}]\n {:b 2})"] 248 | (is (= expected (-> sample 249 | z/of-string 250 | z/down z/right z/down 251 | pe/slurp-forward 252 | z/root-string))))) 253 | 254 | (deftest slurp-forward-fully 255 | (is (= "[1 [2 3 4]]" (-> (z/of-string "[1 [2] 3 4]") 256 | z/down z/right z/down 257 | pe/slurp-forward-fully 258 | z/root-string)))) 259 | 260 | 261 | 262 | (deftest slurp-backward-and-keep-loc-leftmost 263 | (let [res (-> "[1 2 [3 4]]" 264 | z/of-string 265 | z/down z/rightmost z/down 266 | pe/slurp-backward)] 267 | (is (= "[1 [2 3 4]]" (-> res z/root-string))) 268 | (is (= "3" (-> res z/string))))) 269 | 270 | (deftest slurp-backward-and-keep-loc-rightmost 271 | (let [res (-> "[1 2 [3 4]]" 272 | z/of-string 273 | z/down z/rightmost z/down z/rightmost 274 | pe/slurp-backward)] 275 | (is (= "[1 [2 3 4]]" (-> res z/root-string))) 276 | (is (= "4" (-> res z/string))))) 277 | 278 | (deftest slurp-backward-from-empty-sexpr 279 | (let [res (-> "[1 2 3 4 []]" 280 | z/of-string 281 | z/down z/rightmost 282 | pe/slurp-backward)] 283 | (is (= "[1 2 3 [4]]" (-> res z/root-string))) 284 | (is (= "4" (-> res z/string))))) 285 | 286 | (deftest slurp-backward-nested 287 | (let [res (-> "[1 2 [[3 4]]]" 288 | z/of-string 289 | z/down z/rightmost z/down z/down z/rightmost 290 | pe/slurp-backward)] 291 | (is (= "[1 [2 [3 4]]]" (-> res z/root-string))) 292 | (is (= "4" (-> res z/string))))) 293 | 294 | (deftest slurp-backward-nested-silly 295 | (let [res (-> "[1 2 [[[3 4]]]]" 296 | z/of-string 297 | z/down z/rightmost z/down z/down z/down z/rightmost 298 | pe/slurp-backward)] 299 | (is (= "[1 [2 [[3 4]]]]" (-> res z/root-string))) 300 | (is (= "4" (-> res z/string))))) 301 | 302 | (deftest slurp-backward-keep-linebreaks-and-comments 303 | (let [res (-> "[1 2 ;dill\n [3 4]]" 304 | z/of-string 305 | z/down z/rightmost z/down 306 | pe/slurp-backward)] 307 | (is (= "[1 [2 ;dill\n 3 4]]" (-> res z/root-string))))) 308 | 309 | 310 | (deftest slurp-backward-fully 311 | (is (= "[[1 2 3 4] 5]" (-> (z/of-string "[1 2 3 [4] 5]") 312 | z/down z/rightmost z/left z/down 313 | pe/slurp-backward-fully 314 | z/root-string)))) 315 | 316 | 317 | (deftest barf-forward-and-keep-loc 318 | (let [res (-> "[[1 2 3] 4]" 319 | z/of-string 320 | z/down z/down z/right; position at 2 321 | pe/barf-forward)] 322 | (is (= "[[1 2] 3 4]" (-> res z/root-string))) 323 | (is (= "2" (-> res z/string))))) 324 | 325 | (deftest barf-forward-at-leftmost 326 | (let [res (-> "[[1 2 3] 4]" 327 | z/of-string 328 | z/down z/down 329 | pe/barf-forward)] 330 | (is (= "[[1 2] 3 4]" (-> res z/root-string))) 331 | (is (= "1" (-> res z/string))))) 332 | 333 | 334 | (deftest barf-forward-at-rightmost-moves-out-of-sexrp 335 | (let [res (-> "[[1 2 3] 4]" 336 | z/of-string 337 | z/down z/down z/rightmost; position at 3 338 | pe/barf-forward)] 339 | 340 | (is (= "[[1 2] 3 4]" (-> res z/root-string))) 341 | (is (= "3" (-> res z/string))))) 342 | 343 | (deftest barf-forward-at-rightmost-which-is-a-whitespace-haha 344 | (let [res (-> "[[1 2 3 ] 4]" 345 | z/of-string 346 | z/down z/down zz/rightmost; position at space at the end 347 | pe/barf-forward)] 348 | 349 | (is (= "[[1 2] 3 4]" (-> res z/root-string))) 350 | (is (= "3" (-> res z/string))))) 351 | 352 | 353 | (deftest barf-forward-at-when-only-one 354 | (let [res (-> "[[1] 2]" 355 | z/of-string 356 | z/down z/down 357 | pe/barf-forward)] 358 | 359 | (is (= "[[] 1 2]" (-> res z/root-string))) 360 | (is (= "1" (-> res z/string))))) 361 | 362 | 363 | 364 | 365 | (deftest barf-backward-and-keep-current-loc 366 | (let [res (-> "[1 [2 3 4]]" 367 | z/of-string 368 | z/down z/rightmost z/down z/rightmost ; position at 4 369 | pe/barf-backward)] 370 | (is (= "[1 2 [3 4]]" (-> res z/root-string))) 371 | (is (= "4" (-> res z/string))))) 372 | 373 | (deftest barf-backward-at-leftmost-moves-out-of-sexpr 374 | (let [res (-> "[1 [2 3 4]]" 375 | z/of-string 376 | z/down z/rightmost z/down ; position at 2 377 | pe/barf-backward)] 378 | (is (= "[1 2 [3 4]]" (-> res z/root-string))) 379 | (is (= "2" (-> res z/string))))) 380 | 381 | 382 | (deftest wrap-around 383 | (is (= "(1)" (-> (z/of-string "1") (pe/wrap-around :list) z/root-string))) 384 | (is (= "[1]" (-> (z/of-string "1") (pe/wrap-around :vector) z/root-string))) 385 | (is (= "{1}" (-> (z/of-string "1") (pe/wrap-around :map) z/root-string))) 386 | (is (= "#{1}" (-> (z/of-string "1") (pe/wrap-around :set) z/root-string)))) 387 | 388 | (deftest wrap-around-keeps-loc 389 | (let [res (-> "1" 390 | z/of-string 391 | (pe/wrap-around :list))] 392 | (is (= "1" (-> res z/string))))) 393 | 394 | (deftest wrap-around-keeps-newlines 395 | (is (= "[[1]\n 2]" (-> (z/of-string "[1\n 2]") z/down (pe/wrap-around :vector) z/root-string)))) 396 | 397 | 398 | 399 | (deftest wrap-around-fn 400 | (is (= "(-> (#(+ 1 1)))" (-> (z/of-string "(-> #(+ 1 1))") 401 | z/down z/right 402 | (pe/wrap-around :list) 403 | z/root-string)))) 404 | 405 | 406 | (deftest wrap-fully-forward-slurp 407 | (is (= "[1 [2 3 4]]" 408 | (-> (z/of-string "[1 2 3 4]") 409 | z/down z/right 410 | (pe/wrap-fully-forward-slurp :vector) 411 | z/root-string)))) 412 | 413 | (deftest splice-killing-backward [] 414 | (let [res (-> (z/of-string "(foo (let ((x 5)) (sqrt n)) bar)") 415 | z/down z/right z/down z/right z/right 416 | pe/splice-killing-backward)] 417 | (is (= "(foo (sqrt n) bar)" (z/root-string res))) 418 | (is (= "(sqrt n)" (z/string res))))) 419 | 420 | 421 | (deftest splice-killing-forward [] 422 | (let [res (-> (z/of-string "(a (b c d e) f)") 423 | z/down z/right z/down z/right z/right 424 | pe/splice-killing-forward)] 425 | (is (= "(a b c f)" (z/root-string res))) 426 | (is (= "c" (z/string res))))) 427 | 428 | (deftest splice-killing-forward-at-leftmost [] 429 | (let [res (-> (z/of-string "(a (b c d e) f)") 430 | z/down z/right z/down 431 | pe/splice-killing-forward)] 432 | (is (= "(a f)" (z/root-string res))) 433 | (is (= "a" (z/string res))))) 434 | 435 | 436 | (deftest split 437 | (let [res (-> "[1 2]" 438 | z/of-string 439 | z/down 440 | pe/split)] 441 | (is (= "[1] [2]" (-> res z/root-string))) 442 | (is (= "1" (-> res z/string))))) 443 | 444 | (deftest split-includes-node-at-loc-as-left 445 | (let [res (-> "[1 2 3 4]" 446 | z/of-string 447 | z/down z/right 448 | pe/split)] 449 | (is (= "[1 2] [3 4]" (-> res z/root-string))) 450 | (is (= "2" (-> res z/string))))) 451 | 452 | 453 | (deftest split-at-whitespace 454 | (let [res (-> "[1 2 3 4]" 455 | z/of-string 456 | z/down z/right zz/right 457 | pe/split)] 458 | (is (= "[1 2] [3 4]" (-> res z/root-string))) 459 | (is (= "2" (-> res z/string))))) 460 | 461 | 462 | 463 | 464 | (deftest split-includes-comments-and-newlines 465 | (let [sexpr " 466 | [1 ;dill 467 | 2 ;dall 468 | 3 ;jalla 469 | ]" 470 | expected " 471 | [1 ;dill 472 | 2 ;dall 473 | ] [3 ;jalla 474 | ]" 475 | res (-> sexpr 476 | z/of-string 477 | z/down z/right 478 | pe/split)] 479 | (is (= expected (-> res z/root-string))) 480 | (is (= "2" (-> res z/string))))) 481 | 482 | (deftest split-when-only-one-returns-self 483 | (is (= "[1]" (-> (z/of-string "[1]") 484 | z/down 485 | pe/split 486 | z/root-string))) 487 | (is (= "[1 ;dill\n]" (-> (z/of-string "[1 ;dill\n]") 488 | z/down 489 | pe/split 490 | z/root-string)))) 491 | 492 | 493 | (deftest split-at-pos-when-string 494 | (is (= "(\"Hello \" \"World\")" (-> (z/of-string "(\"Hello World\")") 495 | (pe/split-at-pos {:row 1 :col 9}) 496 | z/root-string)))) 497 | 498 | 499 | (deftest join-simple 500 | (let [res (-> "[1 2] [3 4]" 501 | z/of-string 502 | ;z/down 503 | zz/right 504 | pe/join)] 505 | (is (= "[1 2 3 4]" (-> res z/root-string))) 506 | (is (= "3" (-> res z/string))))) 507 | 508 | (deftest join-with-comments 509 | (let [sexpr " 510 | [[1 2] ; the first stuff 511 | [3 4] ; the second stuff 512 | ]" expected " 513 | [[1 2 ; the first stuff 514 | 3 4]; the second stuff 515 | ]" 516 | res (-> sexpr 517 | z/of-string 518 | z/down zz/right 519 | pe/join)] 520 | (is (= expected (-> res z/root-string))))) 521 | 522 | 523 | (deftest join-strings 524 | (is (= "(\"Hello World\")" (-> (z/of-string "(\"Hello \" \"World\")") 525 | z/down z/rightmost 526 | pe/join 527 | z/root-string)))) 528 | 529 | 530 | (deftest raise 531 | (is (= "[1 3]" 532 | (-> (z/of-string "[1 [2 3 4]]") 533 | z/down z/right z/down z/right 534 | pe/raise 535 | z/root-string)))) 536 | 537 | 538 | (deftest move-to-prev-flat 539 | (is (= "(+ 2 1)" (-> "(+ 1 2)" 540 | z/of-string 541 | z/down 542 | z/rightmost 543 | pe/move-to-prev 544 | z/root-string)))) 545 | 546 | (deftest move-to-prev-when-prev-is-seq 547 | (is (= "(+ 1 (+ 2 3 4))" (-> "(+ 1 (+ 2 3) 4)" 548 | z/of-string 549 | z/down 550 | z/rightmost 551 | pe/move-to-prev 552 | z/root-string)))) 553 | 554 | (deftest move-to-prev-out-of-seq 555 | (is (= "(+ 1 4 (+ 2 3))" (-> "(+ 1 (+ 2 3) 4)" 556 | z/of-string 557 | z/down 558 | z/rightmost 559 | (move-n pe/move-to-prev 6) 560 | z/root-string)))) 561 | -------------------------------------------------------------------------------- /test/rewrite_clj/runner.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.runner 2 | (:require [doo.runner :refer-macros [doo-tests]] 3 | [rewrite-clj.zip-test] 4 | [rewrite-clj.paredit-test] 5 | [rewrite-clj.node-test] 6 | [rewrite-clj.zip.seqz-test] 7 | [rewrite-clj.zip.findz-test] 8 | [rewrite-clj.zip.editz-test])) 9 | 10 | (doo-tests 'rewrite-clj.zip-test 11 | 'rewrite-clj.paredit-test 12 | 'rewrite-clj.node-test 13 | 'rewrite-clj.zip.seqz-test 14 | 'rewrite-clj.zip.findz-test 15 | 'rewrite-clj.zip.editz-test) 16 | -------------------------------------------------------------------------------- /test/rewrite_clj/zip/editz_test.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.zip.editz-test 2 | (:require [cljs.test :refer-macros [deftest is testing run-tests]] 3 | [rewrite-clj.zip :as z] 4 | [rewrite-clj.node :as n] 5 | [rewrite-clj.zip.editz :as e])) 6 | 7 | 8 | 9 | (deftest splice 10 | (is (= "[1 2 [3 4]]" (-> "[[1 2] [3 4]]" 11 | z/of-string 12 | z/down 13 | e/splice 14 | z/root-string)))) 15 | -------------------------------------------------------------------------------- /test/rewrite_clj/zip/findz_test.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.zip.findz-test 2 | (:require [cljs.test :refer-macros [deftest is testing run-tests]] 3 | [rewrite-clj.zip :as z] 4 | [rewrite-clj.node :as n] 5 | [rewrite-clj.zip.findz :as f])) 6 | 7 | 8 | 9 | (deftest find-last-by-pos 10 | (is (= "2" (-> "[1 2 3]" 11 | z/of-string 12 | (f/find-last-by-pos {:row 1 :col 4} (constantly true)) 13 | z/string)))) 14 | 15 | (deftest find-last-by-pos-when-whitespace 16 | (is (= " " (-> "[1 2 3]" 17 | z/of-string 18 | (f/find-last-by-pos {:row 1 :col 3} (constantly true)) 19 | z/string)))) 20 | 21 | 22 | (deftest find-last-by-pos-multiline 23 | (let [sample " 24 | {:a 1 25 | :b 2}" ] 26 | (is (= ":a" (-> sample 27 | z/of-string 28 | (f/find-last-by-pos {:row 2 :col 2}) 29 | z/string))) 30 | (is (= "1" (-> sample 31 | z/of-string 32 | (f/find-last-by-pos {:row 2 :col 5}) 33 | z/string))))) 34 | 35 | (deftest find-tag-by-pos 36 | (is (= "[4 5 6]" (-> "[1 2 3 [4 5 6]]" 37 | z/of-string 38 | (f/find-tag-by-pos {:row 1 :col 8} :vector) 39 | z/string)))) 40 | 41 | 42 | (deftest find-tag-by-pos-set 43 | (is (= "#{4 5 6}" (-> "[1 2 3 #{4 5 6}]" 44 | z/of-string 45 | (f/find-tag-by-pos {:row 1 :col 10} :set) 46 | z/string)))) 47 | -------------------------------------------------------------------------------- /test/rewrite_clj/zip/seqz_test.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.zip.seqz-test 2 | (:require [cljs.test :refer-macros [deftest is testing run-tests]] 3 | [rewrite-clj.zip :as z] 4 | [rewrite-clj.node :as n] 5 | [rewrite-clj.zip.seqz :as seqz])) 6 | 7 | 8 | 9 | (deftest check-predicates 10 | (is (-> "[1 2 3]" z/of-string z/vector?)) 11 | (is (-> "{:a 1}" z/of-string z/map?)) 12 | (is (-> "#{1 2}" z/of-string z/set?)) 13 | (is (-> "(+ 2 3)" z/of-string z/list?)) 14 | (is (-> "[1 2]" z/of-string z/seq?))) 15 | 16 | (deftest get-from-map 17 | (is (= 1 (-> "{:a 1}" z/of-string (z/get :a) z/node :value)))) 18 | 19 | (deftest get-from-vector 20 | (is (= 10 (-> "[5 10 15]" z/of-string (z/get 1) z/node :value)))) 21 | 22 | (deftest get-from-vector-index-out-of-bounds 23 | (is (thrown-with-msg? js/Error #"Index out of bounds" 24 | (-> "[5 10 15]" z/of-string (z/get 5) z/node :value)))) 25 | 26 | (deftest map-on-vector 27 | (let [sexpr "[1\n2\n3]" 28 | expected "[5\n6\n7]"] 29 | (is (= expected (->> sexpr z/of-string (z/map #(z/edit % + 4)) z/root-string))))) 30 | 31 | 32 | (deftest assoc-on-map 33 | (is (contains? (-> "{:a 1}" z/of-string (z/assoc :b 2) z/node n/sexpr) :b))) 34 | -------------------------------------------------------------------------------- /test/rewrite_clj/zip_test.cljs: -------------------------------------------------------------------------------- 1 | (ns rewrite-clj.zip-test 2 | (:require [cljs.test :refer-macros [deftest is testing run-tests]] 3 | [rewrite-clj.zip :as z] 4 | [rewrite-clj.node :as n])) 5 | 6 | 7 | (deftest of-string-simple-sexpr 8 | (let [sexpr "(+ 1 2)"] 9 | (is (= sexpr (-> sexpr z/of-string z/root-string))))) 10 | 11 | 12 | 13 | (deftest manipulate-sexpr 14 | (let [sexpr " 15 | ^{:dynamic true} (+ 1 1 16 | (+ 2 2) 17 | (reduce + [1 3 4]))" 18 | expected " 19 | ^{:dynamic true} (+ 1 1 20 | (+ 2 2) 21 | (reduce + [6 7 [1 2]]))"] 22 | (is (= expected (-> sexpr 23 | z/of-string 24 | (z/find-tag-by-pos {:row 4 :col 19} :vector) 25 | (z/replace [5 6 7]) 26 | (z/append-child [1 2]) 27 | z/down 28 | z/remove 29 | z/root-string))))) 30 | 31 | 32 | (deftest namespaced-keywords 33 | (is (= ":dill" (-> ":dill" z/of-string z/root-string))) 34 | (is (= "::dill" (-> "::dill" z/of-string z/root-string))) 35 | (is (= ":dill/dall" (-> ":dill/dall" z/of-string z/root-string))) 36 | (is (= "::dill/dall" (-> "::dill/dall" z/of-string z/root-string))) 37 | (is (= ":%dill.*" (-> ":%dill.*" z/of-string z/root-string)))) 38 | --------------------------------------------------------------------------------