├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── README.md ├── project.clj ├── src ├── aiba │ └── lein_count │ │ ├── clojure_tools │ │ ├── reader.clj │ │ └── reader │ │ │ ├── default_data_readers.clj │ │ │ ├── edn.clj │ │ │ ├── impl │ │ │ ├── commons.clj │ │ │ └── utils.clj │ │ │ └── reader_types.clj │ │ ├── core.clj │ │ └── utils.clj └── leiningen │ └── count.clj ├── test-data ├── aliased_ns_kw.clj ├── constants.clj ├── fn_doc.clj ├── just_a_ns.cljs ├── malformed.clj ├── tags.clj └── test1.clj └── test └── aiba └── lein_count └── core_test.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | pom.xml 3 | pom.xml.asc 4 | /.nrepl-port 5 | *.DS_Store 6 | /.lein-* 7 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Change Log 2 | 3 | ## 1.0.9 4 | 5 | * Include fully custom branch version of tools-reader to avoid dependency conflicts (Fixes #1). 6 | 7 | ## 1.0.8 8 | 9 | * BUGFIX: previous versions were over-counting constant nodes in the AST. 10 | * Added unit tests. 11 | 12 | ## 1.0.7 13 | 14 | * Better path deduplication. 15 | 16 | ## 1.0.6 17 | 18 | * Non-existent file or directory is nonfatal. Will just print warning. 19 | 20 | ## 1.0.4 21 | 22 | * Works on Windows. 23 | 24 | ## 1.0.3 25 | 26 | * Fix double-counting of files when the same `:source-path` is specified more than 27 | once. 28 | 29 | ## 1.0.2 30 | 31 | * Exclude `org.clojure/clojure` from project dependencies. 32 | 33 | ## 1.0.1 34 | 35 | * Fix parsing of artifacts with periods in the name. 36 | 37 | ## 1.0.0 38 | 39 | * Works on artifacts 40 | * :by-file switch 41 | * Fix for namespaced aliased keyword parsing. 42 | * Documentation 43 | 44 | ## 0.0.1 - 2017-05-09 45 | 46 | * Initial version working. 47 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 2 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 3 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 4 | 5 | 1. DEFINITIONS 6 | 7 | "Contribution" means: 8 | 9 | a) in the case of the initial Contributor, the initial code and 10 | documentation distributed under this Agreement, and 11 | 12 | b) in the case of each subsequent Contributor: 13 | 14 | i) changes to the Program, and 15 | 16 | ii) additions to the Program; 17 | 18 | where such changes and/or additions to the Program originate from and are 19 | distributed by that particular Contributor. A Contribution 'originates' from 20 | a Contributor if it was added to the Program by such Contributor itself or 21 | anyone acting on such Contributor's behalf. Contributions do not include 22 | additions to the Program which: (i) are separate modules of software 23 | distributed in conjunction with the Program under their own license 24 | agreement, and (ii) are not derivative works of the Program. 25 | 26 | "Contributor" means any person or entity that distributes the Program. 27 | 28 | "Licensed Patents" mean patent claims licensable by a Contributor which are 29 | necessarily infringed by the use or sale of its Contribution alone or when 30 | combined with the Program. 31 | 32 | "Program" means the Contributions distributed in accordance with this 33 | Agreement. 34 | 35 | "Recipient" means anyone who receives the Program under this Agreement, 36 | including all Contributors. 37 | 38 | 2. GRANT OF RIGHTS 39 | 40 | a) Subject to the terms of this Agreement, each Contributor hereby grants 41 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 42 | reproduce, prepare derivative works of, publicly display, publicly perform, 43 | distribute and sublicense the Contribution of such Contributor, if any, and 44 | such derivative works, in source code and object code form. 45 | 46 | b) Subject to the terms of this Agreement, each Contributor hereby grants 47 | Recipient a non-exclusive, worldwide, royalty-free patent license under 48 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 49 | transfer the Contribution of such Contributor, if any, in source code and 50 | object code form. This patent license shall apply to the combination of the 51 | Contribution and the Program if, at the time the Contribution is added by the 52 | Contributor, such addition of the Contribution causes such combination to be 53 | covered by the Licensed Patents. The patent license shall not apply to any 54 | other combinations which include the Contribution. No hardware per se is 55 | licensed hereunder. 56 | 57 | c) Recipient understands that although each Contributor grants the licenses 58 | to its Contributions set forth herein, no assurances are provided by any 59 | Contributor that the Program does not infringe the patent or other 60 | intellectual property rights of any other entity. Each Contributor disclaims 61 | any liability to Recipient for claims brought by any other entity based on 62 | infringement of intellectual property rights or otherwise. As a condition to 63 | exercising the rights and licenses granted hereunder, each Recipient hereby 64 | assumes sole responsibility to secure any other intellectual property rights 65 | needed, if any. For example, if a third party patent license is required to 66 | allow Recipient to distribute the Program, it is Recipient's responsibility 67 | to acquire that license before distributing the Program. 68 | 69 | d) Each Contributor represents that to its knowledge it has sufficient 70 | copyright rights in its Contribution, if any, to grant the copyright license 71 | set forth in this Agreement. 72 | 73 | 3. REQUIREMENTS 74 | 75 | A Contributor may choose to distribute the Program in object code form under 76 | its own license agreement, provided that: 77 | 78 | a) it complies with the terms and conditions of this Agreement; and 79 | 80 | b) its license agreement: 81 | 82 | i) effectively disclaims on behalf of all Contributors all warranties and 83 | conditions, express and implied, including warranties or conditions of title 84 | and non-infringement, and implied warranties or conditions of merchantability 85 | and fitness for a particular purpose; 86 | 87 | ii) effectively excludes on behalf of all Contributors all liability for 88 | damages, including direct, indirect, special, incidental and consequential 89 | damages, such as lost profits; 90 | 91 | iii) states that any provisions which differ from this Agreement are offered 92 | by that Contributor alone and not by any other party; and 93 | 94 | iv) states that source code for the Program is available from such 95 | Contributor, and informs licensees how to obtain it in a reasonable manner on 96 | or through a medium customarily used for software exchange. 97 | 98 | When the Program is made available in source code form: 99 | 100 | a) it must be made available under this Agreement; and 101 | 102 | b) a copy of this Agreement must be included with each copy of the Program. 103 | 104 | Contributors may not remove or alter any copyright notices contained within 105 | the Program. 106 | 107 | Each Contributor must identify itself as the originator of its Contribution, 108 | if any, in a manner that reasonably allows subsequent Recipients to identify 109 | the originator of the Contribution. 110 | 111 | 4. COMMERCIAL DISTRIBUTION 112 | 113 | Commercial distributors of software may accept certain responsibilities with 114 | respect to end users, business partners and the like. While this license is 115 | intended to facilitate the commercial use of the Program, the Contributor who 116 | includes the Program in a commercial product offering should do so in a 117 | manner which does not create potential liability for other Contributors. 118 | Therefore, if a Contributor includes the Program in a commercial product 119 | offering, such Contributor ("Commercial Contributor") hereby agrees to defend 120 | and indemnify every other Contributor ("Indemnified Contributor") against any 121 | losses, damages and costs (collectively "Losses") arising from claims, 122 | lawsuits and other legal actions brought by a third party against the 123 | Indemnified Contributor to the extent caused by the acts or omissions of such 124 | Commercial Contributor in connection with its distribution of the Program in 125 | a commercial product offering. The obligations in this section do not apply 126 | to any claims or Losses relating to any actual or alleged intellectual 127 | property infringement. In order to qualify, an Indemnified Contributor must: 128 | a) promptly notify the Commercial Contributor in writing of such claim, and 129 | b) allow the Commercial Contributor to control, and cooperate with the 130 | Commercial Contributor in, the defense and any related settlement 131 | negotiations. The Indemnified Contributor may participate in any such claim 132 | at its own expense. 133 | 134 | For example, a Contributor might include the Program in a commercial product 135 | offering, Product X. That Contributor is then a Commercial Contributor. If 136 | that Commercial Contributor then makes performance claims, or offers 137 | warranties related to Product X, those performance claims and warranties are 138 | such Commercial Contributor's responsibility alone. Under this section, the 139 | Commercial Contributor would have to defend claims against the other 140 | Contributors related to those performance claims and warranties, and if a 141 | court requires any other Contributor to pay any damages as a result, the 142 | Commercial Contributor must pay those damages. 143 | 144 | 5. NO WARRANTY 145 | 146 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON 147 | AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER 148 | EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR 149 | CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A 150 | PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the 151 | appropriateness of using and distributing the Program and assumes all risks 152 | associated with its exercise of rights under this Agreement , including but 153 | not limited to the risks and costs of program errors, compliance with 154 | applicable laws, damage to or loss of data, programs or equipment, and 155 | unavailability or interruption of operations. 156 | 157 | 6. DISCLAIMER OF LIABILITY 158 | 159 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 160 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 161 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 162 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 163 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 164 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 165 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 166 | OF SUCH DAMAGES. 167 | 168 | 7. GENERAL 169 | 170 | If any provision of this Agreement is invalid or unenforceable under 171 | applicable law, it shall not affect the validity or enforceability of the 172 | remainder of the terms of this Agreement, and without further action by the 173 | parties hereto, such provision shall be reformed to the minimum extent 174 | necessary to make such provision valid and enforceable. 175 | 176 | If Recipient institutes patent litigation against any entity (including a 177 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 178 | (excluding combinations of the Program with other software or hardware) 179 | infringes such Recipient's patent(s), then such Recipient's rights granted 180 | under Section 2(b) shall terminate as of the date such litigation is filed. 181 | 182 | All Recipient's rights under this Agreement shall terminate if it fails to 183 | comply with any of the material terms or conditions of this Agreement and 184 | does not cure such failure in a reasonable period of time after becoming 185 | aware of such noncompliance. If all Recipient's rights under this Agreement 186 | terminate, Recipient agrees to cease use and distribution of the Program as 187 | soon as reasonably practicable. However, Recipient's obligations under this 188 | Agreement and any licenses granted by Recipient relating to the Program shall 189 | continue and survive. 190 | 191 | Everyone is permitted to copy and distribute copies of this Agreement, but in 192 | order to avoid inconsistency the Agreement is copyrighted and may only be 193 | modified in the following manner. The Agreement Steward reserves the right to 194 | publish new versions (including revisions) of this Agreement from time to 195 | time. No one other than the Agreement Steward has the right to modify this 196 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 197 | Eclipse Foundation may assign the responsibility to serve as the Agreement 198 | Steward to a suitable separate entity. Each new version of the Agreement will 199 | be given a distinguishing version number. The Program (including 200 | Contributions) may always be distributed subject to the version of the 201 | Agreement under which it was received. In addition, after a new version of 202 | the Agreement is published, Contributor may elect to distribute the Program 203 | (including its Contributions) under the new version. Except as expressly 204 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 205 | licenses to the intellectual property of any Contributor under this 206 | Agreement, whether expressly, by implication, estoppel or otherwise. All 207 | rights in the Program not expressly granted under this Agreement are 208 | reserved. 209 | 210 | This Agreement is governed by the laws of the State of New York and the 211 | intellectual property laws of the United States of America. No party to this 212 | Agreement will bring a legal action under this Agreement more than one year 213 | after the cause of action arose. Each party waives its rights to a jury trial 214 | in any resulting litigation. 215 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # lein-count 2 | 3 | Use this instead of `cloc` to count lines of clojure code. 4 | 5 | Unlike `cloc` and other tools, lein-count uses [clojure.tools.reader][ctr] to parse 6 | code to decide which lines count. This means `(comment ...)` forms and 7 | `#_(reader-ignored forms)` are not counted. 8 | 9 | [Rationale](http://aaroniba.net/counting-clojure-code) 10 | 11 | [ctr]: https://github.com/clojure/tools.reader 12 | 13 | ## Usage 14 | 15 | Merge into `~/.lein/profiles.clj`: 16 | 17 | ```clojure 18 | {:user {:plugins [[lein-count "1.0.9"]]}} 19 | ``` 20 | 21 | Now you can run `lein count` in a project. Example: 22 | 23 | ``` 24 | $ cd ~/oss/clojurescript 25 | $ lein count 26 | Examining ("src/main/clojure" "src/main/cljs") 27 | Found 62 source files. 28 | 29 | |------+-------+---------------+--------| 30 | | Ext | Files | Lines of Code | Nodes | 31 | |------+-------+---------------+--------| 32 | | cljs | 26 | 16247 | 84666 | 33 | | cljc | 16 | 9567 | 73249 | 34 | | clj | 20 | 3843 | 19789 | 35 | | ____ | _____ | _____________ | _____ | 36 | | SUM: | 62 | 29657 | 177704 | 37 | |------+-------+---------------+--------| 38 | ``` 39 | 40 | ### Outside a project 41 | 42 | It also works outside a project if you specify which files or directories to be scanned. 43 | 44 | ``` 45 | $ lein count some_file.clj 46 | $ lein count /tmp/dir-of-files 47 | $ lein count :by-file /tmp/dir-of-files 48 | ``` 49 | 50 | ### :by-file 51 | 52 | You can also use the `:by-file` switch to show individual file counts. 53 | 54 | ``` 55 | $ cd ~/git/lein-count 56 | $ lein count :by-file 57 | Examining ("src") 58 | Found 3 source files. 59 | 60 | |------+----------------------------------------------------+---------------+-------| 61 | | Ext | File | Lines of Code | Nodes | 62 | |------+----------------------------------------------------+---------------+-------| 63 | | clj | ./src/aiba/lein_count/constant_wrapping_reader.clj | 829 | 4203 | 64 | | clj | ./src/aiba/lein_count/core.clj | 154 | 893 | 65 | | clj | ./src/leiningen/count.clj | 67 | 355 | 66 | | clj | ./src/aiba/lein_count/utils.clj | 30 | 172 | 67 | | ____ | __________________________________________________ | _____________ | _____ | 68 | | | SUM: | 1080 | 5623 | 69 | |------+----------------------------------------------------+---------------+-------| 70 | ``` 71 | 72 | ### Artifacts 73 | 74 | `lein count` works on maven artifacts. 75 | 76 | ``` 77 | $ lein count :artifact ring/ring-core 1.6.0 78 | Examining ("/Users/aiba/.m2/repository/ring/ring-core/1.6.0/ring-core-1.6.0.jar") 79 | Found 26 source files. 80 | 81 | |------+-------+---------------+-------| 82 | | Ext | Files | Lines of Code | Nodes | 83 | |------+-------+---------------+-------| 84 | | clj | 26 | 1537 | 6261 | 85 | | ____ | _____ | _____________ | _____ | 86 | | SUM: | 26 | 1537 | 6261 | 87 | |------+-------+---------------+-------| 88 | ``` 89 | 90 | More examples: 91 | 92 | ``` 93 | $ lein count :by-file :artifact ring/ring-core 1.6.0 94 | $ lein count :artifact reagent 0.6.1 95 | $ lein count :by-file :artifact reagent 0.6.1 96 | ``` 97 | 98 | This is a potentially interesting way to evaluate which libraries to depend on. 99 | 100 | ## Counting Nodes 101 | 102 | You might notice that there is another column called "nodes". This is a potentially 103 | more accurate measure of the "length" of code. Let's see if it's useful. 104 | 105 | ## Implementation 106 | 107 | We use a modified version of [clojure.tools.reader][ctr] to parse the source files. 108 | The modifications make the reader more lenient and also wrap constant values in 109 | metadata so they get counted. Once a file is parsed, we simply count the unique 110 | lines upon which a clojure form starts or ends. 111 | 112 | If you find an example where this seems off, please file an github issue. 113 | 114 | The node count is just the total number of parsed forms. 115 | 116 | ## Known Issues 117 | 118 | Versions prior to 1.0.8 had a bug that overcounted constant nodes in the syntax tree 119 | by a lot. See #8. 120 | 121 | ## License 122 | 123 | Source Copyright © 2017 [Aaron Iba](http://aaroniba.net/) 124 | 125 | Distributed under the Eclipse Public License, the same as Clojure uses. 126 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject lein-count "1.0.9" 2 | :description "Counts lines (and nodes) of clojure code" 3 | :url "https://github.com/aiba/lein-count" 4 | :license {:name "Eclipse Public License" :url "http://www.eclipse.org/legal/epl-v10.html"} 5 | :eval-in-leiningen true 6 | :dependencies [[doric "0.9.0"] 7 | [org.clojure/clojure "1.9.0" :scope "provided"]]) 8 | -------------------------------------------------------------------------------- /src/aiba/lein_count/clojure_tools/reader.clj: -------------------------------------------------------------------------------- 1 | 2 | ;;---------------------------------------------------------------------------------------- 3 | ;; NOTE: this constant-wrapping reader verison is based on 4 | ;; https://dev.clojure.org/jira/browse/TRDR-42 5 | ;; Thank you Thomas Heller. 6 | ;; 7 | ;; I made further modifications to read-keyword to enable constant-wrapping of 8 | ;; keywords, and fixed has-feature? and read-arg to support wrapped constants. 9 | ;; -- aiba 10 | ;; 11 | ;; ---------------------------------------------------------------------------------------- 12 | 13 | 14 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 15 | ;; The use and distribution terms for this software are covered by the 16 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 17 | ;; which can be found in the file epl-v10.html at the root of this distribution. 18 | ;; By using this software in any fashion, you are agreeing to be bound by 19 | ;; the terms of this license. 20 | ;; You must not remove this notice, or any other, from this software. 21 | 22 | (ns ^{:doc "A clojure reader in clojure" 23 | :author "Bronsa"} 24 | aiba.lein-count.clojure-tools.reader 25 | (:refer-clojure :exclude [read read-line read-string char 26 | default-data-readers *default-data-reader-fn* 27 | *read-eval* *data-readers* *suppress-read*]) 28 | (:require [aiba.lein-count.clojure-tools.reader.reader-types :refer 29 | [read-char reader-error unread peek-char indexing-reader? 30 | get-line-number get-column-number get-file-name string-push-back-reader 31 | log-source]] 32 | [aiba.lein-count.clojure-tools.reader.impl.utils :refer :all] ;; [char ex-info? whitespace? numeric? desugar-meta] 33 | [aiba.lein-count.clojure-tools.reader.impl.commons :refer :all] 34 | [aiba.lein-count.clojure-tools.reader.default-data-readers :as data-readers]) 35 | (:import (clojure.lang PersistentHashSet IMeta 36 | RT Symbol Reflector Var IObj 37 | PersistentVector IRecord Namespace) 38 | java.lang.reflect.Constructor 39 | (java.util regex.Pattern List LinkedList))) 40 | 41 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 42 | ;; helpers 43 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 44 | 45 | (declare ^:private read* 46 | macros dispatch-macros 47 | ^:dynamic *read-eval* 48 | ^:dynamic *data-readers* 49 | ^:dynamic *default-data-reader-fn* 50 | ^:dynamic *suppress-read* 51 | default-data-readers) 52 | 53 | (def ^:dynamic *wrap-constants* false) 54 | 55 | (defn ^:private ns-name* [x] 56 | (if (instance? Namespace x) 57 | (name (ns-name x)) 58 | (name x))) 59 | 60 | (defn- macro-terminating? [ch] 61 | (case ch 62 | (\" \; \@ \^ \` \~ \( \) \[ \] \{ \} \\) true 63 | false)) 64 | 65 | (defn starting-line-col-info [rdr] 66 | (when (indexing-reader? rdr) 67 | [(get-line-number rdr) (int (dec (int (get-column-number rdr))))])) 68 | 69 | (defn ending-line-col-info [rdr] 70 | (when (indexing-reader? rdr) 71 | [(get-line-number rdr) (get-column-number rdr)])) 72 | 73 | (defn loc-info 74 | ([loc-start rdr] 75 | (loc-info loc-start rdr 0)) 76 | ([[start-line start-column :as loc-start] rdr start-col-offset] 77 | (when loc-start 78 | (merge 79 | (when-let [file (get-file-name rdr)] 80 | {:file file}) 81 | (let [[end-line end-column] (ending-line-col-info rdr)] 82 | {:line start-line 83 | :column (+ start-column start-col-offset) 84 | :end-line end-line 85 | :end-column end-column}))))) 86 | 87 | (defrecord Constant [loc-info value]) 88 | 89 | (defn constant? [x] 90 | (instance? Constant x)) 91 | 92 | (defn const-val [x] 93 | (if (constant? x) 94 | (:value x) 95 | x)) 96 | 97 | (defn wrap-constant [loc-start rdr constant] 98 | (if-not *wrap-constants* 99 | constant 100 | (Constant. (loc-info loc-start rdr) constant))) 101 | 102 | (defn- ^String read-token 103 | "Read in a single logical token from the reader" 104 | [rdr initch] 105 | (if-not initch 106 | (reader-error rdr "EOF while reading") 107 | (loop [sb (StringBuilder.) ch initch] 108 | (if (or (whitespace? ch) 109 | (macro-terminating? ch) 110 | (nil? ch)) 111 | (do (when ch 112 | (unread rdr ch)) 113 | (str sb)) 114 | (recur (.append sb ch) (read-char rdr)))))) 115 | 116 | (declare read-tagged) 117 | 118 | (defn- read-dispatch 119 | [rdr _ opts pending-forms] 120 | (if-let [ch (read-char rdr)] 121 | (if-let [dm (dispatch-macros ch)] 122 | (dm rdr ch opts pending-forms) 123 | (read-tagged (doto rdr (unread ch)) ch opts pending-forms)) ;; ctor reader is implemented as a tagged literal 124 | (reader-error rdr "EOF while reading character"))) 125 | 126 | (defn- read-unmatched-delimiter 127 | [rdr ch opts pending-forms] 128 | (reader-error rdr "Unmatched delimiter " ch)) 129 | 130 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 131 | ;; readers 132 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 133 | 134 | (defn read-regex 135 | [rdr ch opts pending-forms] 136 | (let [loc-start (starting-line-col-info rdr) 137 | sb (StringBuilder.)] 138 | (loop [ch (read-char rdr)] 139 | (if (identical? \" ch) 140 | (wrap-constant loc-start rdr (Pattern/compile (str sb))) 141 | (if (nil? ch) 142 | (reader-error rdr "EOF while reading regex") 143 | (do 144 | (.append sb ch ) 145 | (when (identical? \\ ch) 146 | (let [ch (read-char rdr)] 147 | (if (nil? ch) 148 | (reader-error rdr "EOF while reading regex")) 149 | (.append sb ch))) 150 | (recur (read-char rdr)))))))) 151 | 152 | (defn- read-unicode-char 153 | ([^String token ^long offset ^long length ^long base] 154 | (let [l (+ offset length)] 155 | (when-not (== (count token) l) 156 | (throw (IllegalArgumentException. (str "Invalid unicode character: \\" token)))) 157 | (loop [i offset uc 0] 158 | (if (== i l) 159 | (char uc) 160 | (let [d (Character/digit (int (nth token i)) (int base))] 161 | (if (== d -1) 162 | (throw (IllegalArgumentException. (str "Invalid digit: " (nth token i)))) 163 | (recur (inc i) (long (+ d (* uc base)))))))))) 164 | 165 | ([rdr initch base length exact?] 166 | (let [base (long base) 167 | length (long length)] 168 | (loop [i 1 uc (long (Character/digit (int initch) (int base)))] 169 | (if (== uc -1) 170 | (throw (IllegalArgumentException. (str "Invalid digit: " initch))) 171 | (if-not (== i length) 172 | (let [ch (peek-char rdr)] 173 | (if (or (whitespace? ch) 174 | (macros ch) 175 | (nil? ch)) 176 | (if exact? 177 | (throw (IllegalArgumentException. 178 | (str "Invalid character length: " i ", should be: " length))) 179 | (char uc)) 180 | (let [d (Character/digit (int ch) (int base))] 181 | (read-char rdr) 182 | (if (== d -1) 183 | (throw (IllegalArgumentException. (str "Invalid digit: " ch))) 184 | (recur (inc i) (long (+ d (* uc base)))))))) 185 | (char uc))))))) 186 | 187 | (def ^:private ^:const upper-limit (int \uD7ff)) 188 | (def ^:private ^:const lower-limit (int \uE000)) 189 | 190 | (defn- read-char** 191 | "Read in a character literal" 192 | [rdr backslash opts pending-forms] 193 | (let [ch (read-char rdr)] 194 | (if-not (nil? ch) 195 | (let [token (if (or (macro-terminating? ch) 196 | (whitespace? ch)) 197 | (str ch) 198 | (read-token rdr ch)) 199 | token-len (count token)] 200 | (cond 201 | 202 | (== 1 token-len) (Character/valueOf (nth token 0)) 203 | 204 | (= token "newline") \newline 205 | (= token "space") \space 206 | (= token "tab") \tab 207 | (= token "backspace") \backspace 208 | (= token "formfeed") \formfeed 209 | (= token "return") \return 210 | 211 | (.startsWith token "u") 212 | (let [c (read-unicode-char token 1 4 16) 213 | ic (int c)] 214 | (if (and (> ic upper-limit) 215 | (< ic lower-limit)) 216 | (reader-error rdr "Invalid character constant: \\u" (Integer/toString ic 16)) 217 | c)) 218 | 219 | (.startsWith token "o") 220 | (let [len (dec token-len)] 221 | (if (> len 3) 222 | (reader-error rdr "Invalid octal escape sequence length: " len) 223 | (let [uc (read-unicode-char token 1 len 8)] 224 | (if (> (int uc) 0377) 225 | (reader-error rdr "Octal escape sequence must be in range [0, 377]") 226 | uc)))) 227 | 228 | :else (reader-error rdr "Unsupported character: \\" token))) 229 | (reader-error rdr "EOF while reading character")))) 230 | 231 | (defn- read-char* 232 | [rdr backslash opts pending-forms] 233 | (let [loc-start (starting-line-col-info rdr) 234 | char (read-char** rdr backslash opts pending-forms)] 235 | (wrap-constant loc-start rdr char) 236 | )) 237 | 238 | (defonce ^:private READ_EOF (Object.)) 239 | (defonce ^:private READ_FINISHED (Object.)) 240 | 241 | (def ^:dynamic *read-delim* false) 242 | (defn- ^PersistentVector read-delimited 243 | "Reads and returns a collection ended with delim" 244 | [delim rdr opts pending-forms] 245 | (let [[start-line start-column] (starting-line-col-info rdr) 246 | delim (char delim)] 247 | (binding [*read-delim* true] 248 | (loop [a (transient [])] 249 | (let [form (read* rdr false READ_EOF delim opts pending-forms)] 250 | (if (identical? form READ_FINISHED) 251 | (persistent! a) 252 | (if (identical? form READ_EOF) 253 | (reader-error rdr "EOF while reading" 254 | (when start-line 255 | (str ", starting at line " start-line " and column " start-column))) 256 | (recur (conj! a form))))))))) 257 | 258 | (defn- read-list 259 | "Read in a list, including its location if the reader is an indexing reader" 260 | [rdr _ opts pending-forms] 261 | (let [loc-start (starting-line-col-info rdr) 262 | the-list (read-delimited \) rdr opts pending-forms)] 263 | (with-meta (if (empty? the-list) 264 | '() 265 | (clojure.lang.PersistentList/create the-list)) 266 | (loc-info loc-start rdr)))) 267 | 268 | (defn- read-vector 269 | "Read in a vector, including its location if the reader is an indexing reader" 270 | [rdr _ opts pending-forms] 271 | (let [loc-start (starting-line-col-info rdr) 272 | the-vector (read-delimited \] rdr opts pending-forms)] 273 | (with-meta the-vector 274 | (loc-info loc-start rdr)))) 275 | 276 | (defn- read-map 277 | "Read in a map, including its location if the reader is an indexing reader" 278 | [rdr _ opts pending-forms] 279 | (let [loc-start (starting-line-col-info rdr) 280 | the-map (read-delimited \} rdr opts pending-forms) 281 | map-count (count the-map)] 282 | (when (odd? map-count) 283 | (reader-error rdr "Map literal must contain an even number of forms")) 284 | (with-meta 285 | (if (zero? map-count) 286 | {} 287 | (RT/map (to-array the-map))) 288 | (loc-info loc-start rdr)))) 289 | 290 | (defn- read-number 291 | [rdr initch] 292 | (let [loc-start (starting-line-col-info rdr)] 293 | (loop [sb (doto (StringBuilder.) (.append initch)) 294 | ch (read-char rdr)] 295 | (if (or (whitespace? ch) (macros ch) (nil? ch)) 296 | (let [s (str sb)] 297 | (unread rdr ch) 298 | (or (when-let [num (match-number s)] 299 | (wrap-constant loc-start rdr num)) 300 | (reader-error rdr "Invalid number format [" s "]"))) 301 | (recur (doto sb (.append ch)) (read-char rdr)))))) 302 | 303 | (defn- escape-char [sb rdr] 304 | (let [ch (read-char rdr)] 305 | (case ch 306 | \t "\t" 307 | \r "\r" 308 | \n "\n" 309 | \\ "\\" 310 | \" "\"" 311 | \b "\b" 312 | \f "\f" 313 | \u (let [ch (read-char rdr)] 314 | (if (== -1 (Character/digit (int ch) 16)) 315 | (reader-error rdr "Invalid unicode escape: \\u" ch) 316 | (read-unicode-char rdr ch 16 4 true))) 317 | (if (numeric? ch) 318 | (let [ch (read-unicode-char rdr ch 8 3 false)] 319 | (if (> (int ch) 0337) 320 | (reader-error rdr "Octal escape sequence must be in range [0, 377]") 321 | ch)) 322 | (reader-error rdr "Unsupported escape character: \\" ch))))) 323 | 324 | (defn- read-string* 325 | [reader _ opts pending-forms] 326 | (let [loc-start (starting-line-col-info reader)] 327 | (loop [sb (StringBuilder.) 328 | ch (read-char reader)] 329 | (case ch 330 | nil (reader-error reader "EOF while reading string") 331 | \\ (recur (doto sb (.append (escape-char sb reader))) 332 | (read-char reader)) 333 | \" (wrap-constant loc-start reader (str sb)) 334 | (recur (doto sb (.append ch)) (read-char reader)))))) 335 | 336 | (defn- read-symbol 337 | [rdr initch] 338 | (let [loc-start (starting-line-col-info rdr)] 339 | (when-let [token (read-token rdr initch)] 340 | (case token 341 | 342 | ;; special symbols 343 | "nil" (wrap-constant loc-start rdr nil) 344 | "true" (wrap-constant loc-start rdr true) 345 | "false" (wrap-constant loc-start rdr false) 346 | "/" '/ ;; FIXME: attach meta? 347 | "NaN" (wrap-constant loc-start rdr Double/NaN) 348 | "-Infinity" (wrap-constant loc-start rdr Double/NEGATIVE_INFINITY) 349 | ("Infinity" "+Infinity") (wrap-constant loc-start rdr Double/POSITIVE_INFINITY) 350 | 351 | (or (when-let [p (parse-symbol token)] 352 | (with-meta (symbol (p 0) (p 1)) 353 | (loc-info loc-start rdr))) 354 | (reader-error rdr "Invalid token: " token)))))) 355 | 356 | (def ^:dynamic *alias-map* 357 | "Map from ns alias to ns, if non-nil, it will be used to resolve read-time 358 | ns aliases instead of (ns-aliases *ns*). 359 | 360 | Defaults to nil" 361 | nil) 362 | 363 | (defn- resolve-ns [sym] 364 | (or ((or *alias-map* 365 | (ns-aliases *ns*)) sym) 366 | (find-ns sym))) 367 | 368 | (defn- read-keyword 369 | [reader initch opts pending-forms] 370 | (let [loc-start (starting-line-col-info reader) 371 | wrap (partial wrap-constant loc-start reader) 372 | ch (read-char reader)] 373 | (if-not (whitespace? ch) 374 | (let [token (read-token reader ch) 375 | s (parse-symbol token)] 376 | (if s 377 | (let [^String ns (s 0) 378 | ^String name (s 1)] 379 | (if (identical? \: (nth token 0)) 380 | (if ns 381 | (let [ns (resolve-ns (symbol (subs ns 1)))] 382 | (if ns 383 | (wrap (keyword (str ns) name)) 384 | (reader-error reader "Invalid token: :" token))) 385 | (wrap (keyword (str *ns*) (subs name 1)))) 386 | (wrap (keyword ns name)))) 387 | (reader-error reader "Invalid token: :" token))) 388 | (reader-error reader "Invalid token: :")))) 389 | 390 | (defn- wrapping-reader 391 | "Returns a function which wraps a reader in a call to sym" 392 | [sym] 393 | (fn [rdr _ opts pending-forms] 394 | (list sym (read* rdr true nil opts pending-forms)))) 395 | 396 | (defn- read-meta 397 | "Read metadata and return the following object with the metadata applied" 398 | [rdr _ opts pending-forms] 399 | (log-source rdr 400 | (let [[line column] (starting-line-col-info rdr) 401 | m (desugar-meta (read* rdr true nil opts pending-forms))] 402 | (when-not (map? m) 403 | (reader-error rdr "Metadata must be Symbol, Keyword, String or Map")) 404 | (let [o (read* rdr true nil opts pending-forms)] 405 | (if (instance? IMeta o) 406 | (let [m (if (and line (seq? o)) 407 | (assoc m :line line :column column) 408 | m)] 409 | (if (instance? IObj o) 410 | (with-meta o (merge (meta o) m)) 411 | (reset-meta! o m))) 412 | (reader-error rdr "Metadata can only be applied to IMetas")))))) 413 | 414 | (defn- read-set 415 | [rdr _ opts pending-forms] 416 | (let [loc-start (starting-line-col-info rdr) 417 | the-set (PersistentHashSet/createWithCheck (read-delimited \} rdr opts pending-forms))] 418 | (with-meta the-set 419 | (loc-info loc-start rdr -1) 420 | ))) 421 | 422 | (defn- read-discard 423 | "Read and discard the first object from rdr" 424 | [rdr _ opts pending-forms] 425 | (doto rdr 426 | (read* true nil opts pending-forms))) 427 | 428 | (def ^:private RESERVED_FEATURES #{:else :none}) 429 | 430 | (defn- has-feature? 431 | [rdr feature opts] 432 | (let [feature (const-val feature)] 433 | (if (keyword? feature) 434 | (or (= :default feature) (contains? (get opts :features) feature)) 435 | (reader-error rdr (str "Feature should be a keyword: " feature))))) 436 | 437 | (defn- check-eof-error 438 | [form rdr ^long first-line] 439 | (when (identical? form READ_EOF) 440 | (if (< first-line 0) 441 | (reader-error rdr "EOF while reading") 442 | (reader-error rdr "EOF while reading, starting at line " first-line)))) 443 | 444 | (defn- check-reserved-features 445 | [rdr form] 446 | (when (get RESERVED_FEATURES form) 447 | (reader-error rdr (str "Feature name " form " is reserved")))) 448 | 449 | (defn- check-invalid-read-cond 450 | [form rdr ^long first-line] 451 | (when (identical? form READ_FINISHED) 452 | (if (< first-line 0) 453 | (reader-error rdr "read-cond requires an even number of forms") 454 | (reader-error rdr (str "read-cond starting on line " first-line " requires an even number of forms"))))) 455 | 456 | (defn- read-suppress 457 | "Read next form and suppress. Return nil or READ_FINISHED." 458 | [first-line rdr opts pending-forms] 459 | (binding [*suppress-read* true] 460 | (let [form (read* rdr false READ_EOF \) opts pending-forms)] 461 | (check-eof-error form rdr first-line) 462 | (when (identical? form READ_FINISHED) 463 | READ_FINISHED)))) 464 | 465 | (def ^:private NO_MATCH (Object.)) 466 | 467 | (defn- match-feature 468 | "Read next feature. If matched, read next form and return. 469 | Otherwise, read and skip next form, returning READ_FINISHED or nil." 470 | [first-line rdr opts pending-forms] 471 | (let [feature (read* rdr false READ_EOF \) opts pending-forms)] 472 | (check-eof-error feature rdr first-line) 473 | (if (= feature READ_FINISHED) 474 | READ_FINISHED 475 | (do 476 | (check-reserved-features rdr feature) 477 | (if (has-feature? rdr feature opts) 478 | ;; feature matched, read selected form 479 | (doto (read* rdr false READ_EOF \) opts pending-forms) 480 | (check-eof-error rdr first-line) 481 | (check-invalid-read-cond rdr first-line)) 482 | ;; feature not matched, ignore next form 483 | (or (read-suppress first-line rdr opts pending-forms) 484 | NO_MATCH)))))) 485 | 486 | (defn- read-cond-delimited 487 | [rdr splicing opts pending-forms] 488 | (let [first-line (if (indexing-reader? rdr) (get-line-number rdr) -1) 489 | result (loop [matched NO_MATCH 490 | finished nil] 491 | (cond 492 | ;; still looking for match, read feature+form 493 | (identical? matched NO_MATCH) 494 | (let [match (match-feature first-line rdr opts pending-forms)] 495 | (if (identical? match READ_FINISHED) 496 | READ_FINISHED 497 | (recur match nil))) 498 | 499 | ;; found match, just read and ignore the rest 500 | (not (identical? finished READ_FINISHED)) 501 | (recur matched (read-suppress first-line rdr opts pending-forms)) 502 | 503 | :else 504 | matched))] 505 | (if (identical? result READ_FINISHED) 506 | rdr 507 | (if splicing 508 | (if (instance? List result) 509 | (do 510 | (.addAll ^List pending-forms 0 ^List result) 511 | rdr) 512 | (reader-error rdr "Spliced form list in read-cond-splicing must implement java.util.List.")) 513 | result)))) 514 | 515 | (defn- read-cond 516 | [rdr _ opts pending-forms] 517 | (when (not (and opts (#{:allow :preserve} (:read-cond opts)))) 518 | (throw (RuntimeException. "Conditional read not allowed"))) 519 | (if-let [ch (read-char rdr)] 520 | (let [splicing (= ch \@) 521 | ch (if splicing (read-char rdr) ch)] 522 | (when splicing 523 | (when-not *read-delim* 524 | (reader-error rdr "cond-splice not in list"))) 525 | (if-let [ch (if (whitespace? ch) (read-past whitespace? rdr) ch)] 526 | (if (not= ch \() 527 | (throw (RuntimeException. "read-cond body must be a list")) 528 | (binding [*suppress-read* (or *suppress-read* (= :preserve (:read-cond opts)))] 529 | (if *suppress-read* 530 | (reader-conditional (read-list rdr ch opts pending-forms) splicing) 531 | (read-cond-delimited rdr splicing opts pending-forms)))) 532 | (reader-error rdr "EOF while reading character"))) 533 | (reader-error rdr "EOF while reading character"))) 534 | 535 | (def ^:private ^:dynamic arg-env) 536 | 537 | (defn- garg 538 | "Get a symbol for an anonymous ?argument?" 539 | [^long n] 540 | (symbol (str (if (== -1 n) "rest" (str "p" n)) 541 | "__" (RT/nextID) "#"))) 542 | 543 | (defn- read-fn 544 | [rdr _ opts pending-forms] 545 | (if (thread-bound? #'arg-env) 546 | (throw (IllegalStateException. "Nested #()s are not allowed"))) 547 | (binding [arg-env (sorted-map)] 548 | (let [form (read* (doto rdr (unread \()) true nil opts pending-forms) ;; this sets bindings 549 | rargs (rseq arg-env) 550 | args (if rargs 551 | (let [higharg (long (key ( first rargs)))] 552 | (let [args (loop [i 1 args (transient [])] 553 | (if (> i higharg) 554 | (persistent! args) 555 | (recur (inc i) (conj! args (or (get arg-env i) 556 | (garg i)))))) 557 | args (if (arg-env -1) 558 | (conj args '& (arg-env -1)) 559 | args)] 560 | args)) 561 | [])] 562 | (list 'fn* args form)))) 563 | 564 | (defn- register-arg 565 | "Registers an argument to the arg-env" 566 | [n] 567 | (if (thread-bound? #'arg-env) 568 | (if-let [ret (arg-env n)] 569 | ret 570 | (let [g (garg n)] 571 | (set! arg-env (assoc arg-env n g)) 572 | g)) 573 | (throw (IllegalStateException. "Arg literal not in #()")))) ;; should never hit this 574 | 575 | (declare read-symbol) 576 | 577 | (defn- read-arg 578 | [rdr pct opts pending-forms] 579 | (if-not (thread-bound? #'arg-env) 580 | (read-symbol rdr pct) 581 | (let [ch (peek-char rdr)] 582 | (cond 583 | (or (whitespace? ch) 584 | (macro-terminating? ch) 585 | (nil? ch)) 586 | (register-arg 1) 587 | 588 | (identical? ch \&) 589 | (do (read-char rdr) 590 | (register-arg -1)) 591 | 592 | :else 593 | (let [n (const-val (read* rdr true nil opts pending-forms))] 594 | (if-not (integer? n) 595 | (throw (IllegalStateException. "Arg literal must be %, %& or %integer")) 596 | (register-arg n))))))) 597 | 598 | (defn- read-eval 599 | "Evaluate a reader literal" 600 | [rdr _ opts pending-forms] 601 | (let [x (read* rdr true nil opts pending-forms)] 602 | (cond 603 | (not *read-eval*) (reader-error rdr "#= not allowed when *read-eval* is false") 604 | (= *read-eval* :skip) x 605 | :else (eval x)))) 606 | 607 | (def ^:private ^:dynamic gensym-env nil) 608 | 609 | (defn- read-unquote 610 | [rdr comma opts pending-forms] 611 | (if-let [ch (peek-char rdr)] 612 | (if (identical? \@ ch) 613 | ((wrapping-reader 'clojure.core/unquote-splicing) (doto rdr read-char) \@ opts pending-forms) 614 | ((wrapping-reader 'clojure.core/unquote) rdr \~ opts pending-forms)))) 615 | 616 | (declare syntax-quote*) 617 | (defn- unquote-splicing? [form] 618 | (and (seq? form) 619 | (= (first form) 'clojure.core/unquote-splicing))) 620 | 621 | (defn- unquote? [form] 622 | (and (seq? form) 623 | (= (first form) 'clojure.core/unquote))) 624 | 625 | (defn- expand-list 626 | "Expand a list by resolving its syntax quotes and unquotes" 627 | [s] 628 | (loop [s (seq s) r (transient [])] 629 | (if s 630 | (let [item (first s) 631 | ret (conj! r 632 | (cond 633 | (unquote? item) (list 'clojure.core/list (second item)) 634 | (unquote-splicing? item) (second item) 635 | :else (list 'clojure.core/list (syntax-quote* item))))] 636 | (recur (next s) ret)) 637 | (seq (persistent! r))))) 638 | 639 | (defn- flatten-map 640 | "Flatten a map into a seq of alternate keys and values" 641 | [form] 642 | (loop [s (seq form) key-vals (transient [])] 643 | (if s 644 | (let [e (first s)] 645 | (recur (next s) (-> key-vals 646 | (conj! (key e)) 647 | (conj! (val e))))) 648 | (seq (persistent! key-vals))))) 649 | 650 | (defn- register-gensym [sym] 651 | (if-not gensym-env 652 | (throw (IllegalStateException. "Gensym literal not in syntax-quote"))) 653 | (or (get gensym-env sym) 654 | (let [gs (symbol (str (subs (name sym) 655 | 0 (dec (count (name sym)))) 656 | "__" (RT/nextID) "__auto__"))] 657 | (set! gensym-env (assoc gensym-env sym gs)) 658 | gs))) 659 | 660 | (defn ^:dynamic resolve-symbol 661 | "Resolve a symbol s into its fully qualified namespace version" 662 | [s] 663 | (if (pos? (.indexOf (name s) ".")) 664 | s ;; If there is a period, it is interop 665 | (if-let [ns-str (namespace s)] 666 | (let [ns (resolve-ns (symbol ns-str))] 667 | (if (or (nil? ns) 668 | (= (ns-name* ns) ns-str)) ;; not an alias 669 | s 670 | (symbol (ns-name* ns) (name s)))) 671 | (if-let [o ((ns-map *ns*) s)] 672 | (if (class? o) 673 | (symbol (.getName ^Class o)) 674 | (if (var? o) 675 | (symbol (-> ^Var o .ns ns-name*) (-> ^Var o .sym name)))) 676 | (symbol (ns-name* *ns*) (name s)))))) 677 | 678 | (defn- add-meta [form ret] 679 | (if (and (instance? IObj form) 680 | (seq (dissoc (meta form) :line :column :end-line :end-column :file :source))) 681 | (list 'clojure.core/with-meta ret (syntax-quote* (meta form))) 682 | ret)) 683 | 684 | (defn- syntax-quote-coll [type coll] 685 | ;; We use sequence rather than seq here to fix http://dev.clojure.org/jira/browse/CLJ-1444 686 | ;; But because of http://dev.clojure.org/jira/browse/CLJ-1586 we still need to call seq on the form 687 | (let [res (list 'clojure.core/sequence 688 | (list 'clojure.core/seq 689 | (cons 'clojure.core/concat 690 | (expand-list coll))))] 691 | (if type 692 | (list 'clojure.core/apply type res) 693 | res))) 694 | 695 | (defn map-func 696 | "Decide which map type to use, array-map if less than 16 elements" 697 | [coll] 698 | (if (>= (count coll) 16) 699 | 'clojure.core/hash-map 700 | 'clojure.core/array-map)) 701 | 702 | (defn- syntax-quote* [form] 703 | (->> 704 | (cond 705 | (special-symbol? form) (list 'quote form) 706 | 707 | (symbol? form) 708 | (list 'quote 709 | (if (namespace form) 710 | (let [maybe-class ((ns-map *ns*) 711 | (symbol (namespace form)))] 712 | (if (class? maybe-class) 713 | (symbol (.getName ^Class maybe-class) (name form)) 714 | (resolve-symbol form))) 715 | (let [sym (name form)] 716 | (cond 717 | (.endsWith sym "#") 718 | (register-gensym form) 719 | 720 | (.startsWith sym ".") 721 | form 722 | 723 | (.endsWith sym ".") 724 | (let [csym (symbol (subs sym 0 (dec (count sym))))] 725 | (symbol (.concat (name (resolve-symbol csym)) "."))) 726 | :else (resolve-symbol form))))) 727 | 728 | (unquote? form) (second form) 729 | (unquote-splicing? form) (throw (IllegalStateException. "unquote-splice not in list")) 730 | 731 | (coll? form) 732 | (cond 733 | 734 | (instance? IRecord form) form 735 | (map? form) (syntax-quote-coll (map-func form) (flatten-map form)) 736 | (vector? form) (list 'clojure.core/vec (syntax-quote-coll nil form)) 737 | (set? form) (syntax-quote-coll 'clojure.core/hash-set form) 738 | (or (seq? form) (list? form)) 739 | (let [seq (seq form)] 740 | (if seq 741 | (syntax-quote-coll nil seq) 742 | '(clojure.core/list))) 743 | 744 | :else (throw (UnsupportedOperationException. "Unknown Collection type"))) 745 | 746 | (or (keyword? form) 747 | (number? form) 748 | (char? form) 749 | (string? form) 750 | (nil? form) 751 | (instance? Boolean form) 752 | (instance? Pattern form)) 753 | form 754 | 755 | :else (list 'quote form)) 756 | (add-meta form))) 757 | 758 | (defn- read-syntax-quote 759 | [rdr backquote opts pending-forms] 760 | (binding [gensym-env {}] 761 | (-> (read* rdr true nil opts pending-forms) 762 | syntax-quote*))) 763 | 764 | (defn- read-namespaced-map 765 | [rdr _ opts pending-forms] 766 | (let [token (read-token rdr (read-char rdr))] 767 | (if-let [ns (cond 768 | (= token ":") 769 | (ns-name *ns*) 770 | 771 | (= \: (first token)) 772 | (some-> token (subs 1) parse-symbol second' symbol resolve-ns ns-name*) 773 | 774 | :else 775 | (some-> token parse-symbol second'))] 776 | 777 | (let [ch (read-past whitespace? rdr)] 778 | (if (identical? ch \{) 779 | (let [items (read-delimited \} rdr opts pending-forms)] 780 | (when (odd? (count items)) 781 | (reader-error rdr "Map literal must contain an even number of forms")) 782 | (let [keys (take-nth 2 items) 783 | vals (take-nth 2 (rest items))] 784 | (RT/map (to-array (mapcat list (namespace-keys (str ns) keys) vals))))) 785 | (reader-error rdr "Namespaced map must specify a map"))) 786 | (reader-error rdr "Invalid token used as namespace in namespaced map: " token)))) 787 | 788 | (defn- macros [ch] 789 | (case ch 790 | \" read-string* 791 | \: read-keyword 792 | \; read-comment 793 | \' (wrapping-reader 'quote) 794 | \@ (wrapping-reader 'clojure.core/deref) 795 | \^ read-meta 796 | \` read-syntax-quote ;;(wrapping-reader 'syntax-quote) 797 | \~ read-unquote 798 | \( read-list 799 | \) read-unmatched-delimiter 800 | \[ read-vector 801 | \] read-unmatched-delimiter 802 | \{ read-map 803 | \} read-unmatched-delimiter 804 | \\ read-char* 805 | \% read-arg 806 | \# read-dispatch 807 | nil)) 808 | 809 | (defn- dispatch-macros [ch] 810 | (case ch 811 | \^ read-meta ;deprecated 812 | \' (wrapping-reader 'var) 813 | \( read-fn 814 | \= read-eval 815 | \{ read-set 816 | \< (throwing-reader "Unreadable form") 817 | \" read-regex 818 | \! read-comment 819 | \_ read-discard 820 | \? read-cond 821 | \: read-namespaced-map 822 | nil)) 823 | 824 | (defn- read-ctor [rdr class-name opts pending-forms] 825 | (cond 826 | (not *read-eval*) 827 | (reader-error "Record construction syntax can only be used when *read-eval* == true") 828 | 829 | (= *read-eval* :skip) 830 | (do (let [ch (read-past whitespace? rdr)] 831 | (when-let [[end-ch form] (case ch 832 | \[ [\] :short] 833 | \{ [\} :extended] 834 | nil)] 835 | (read-delimited end-ch rdr opts pending-forms) 836 | nil))) 837 | 838 | :else 839 | (let [class (Class/forName (name class-name) false (RT/baseLoader)) 840 | ch (read-past whitespace? rdr)] ;; differs from clojure 841 | (if-let [[end-ch form] (case ch 842 | \[ [\] :short] 843 | \{ [\} :extended] 844 | nil)] 845 | (let [entries (to-array (read-delimited end-ch rdr opts pending-forms)) 846 | numargs (count entries) 847 | all-ctors (.getConstructors class) 848 | ctors-num (count all-ctors)] 849 | (case form 850 | :short 851 | (loop [i 0] 852 | (if (>= i ctors-num) 853 | (reader-error rdr "Unexpected number of constructor arguments to " (str class) 854 | ": got" numargs) 855 | (if (== (count (.getParameterTypes ^Constructor (aget all-ctors i))) 856 | numargs) 857 | (Reflector/invokeConstructor class entries) 858 | (recur (inc i))))) 859 | :extended 860 | (let [vals (RT/map entries)] 861 | (loop [s (keys vals)] 862 | (if s 863 | (if-not (keyword? (first s)) 864 | (reader-error rdr "Unreadable ctor form: key must be of type clojure.lang.Keyword") 865 | (recur (next s))))) 866 | (Reflector/invokeStaticMethod class "create" (object-array [vals]))))) 867 | (reader-error rdr "Invalid reader constructor form"))))) 868 | 869 | (defn- read-tagged [rdr initch opts pending-forms] 870 | (let [tag (read* rdr true nil opts pending-forms)] 871 | (if-not (symbol? tag) 872 | (reader-error rdr "Reader tag must be a symbol")) 873 | (if *suppress-read* 874 | (tagged-literal tag (read* rdr true nil opts pending-forms)) 875 | (if-let [f (or (*data-readers* tag) 876 | (default-data-readers tag))] 877 | (f (const-val (read* rdr true nil opts pending-forms))) 878 | (if (.contains (name tag) ".") 879 | (read-ctor rdr tag opts pending-forms) 880 | (if-let [f *default-data-reader-fn*] 881 | (f tag (read* rdr true nil opts pending-forms)) 882 | (reader-error rdr "No reader function for tag " (name tag)))))))) 883 | 884 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 885 | ;; Public API 886 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 887 | 888 | (def ^:dynamic *read-eval* 889 | "Defaults to true. 890 | 891 | ***WARNING*** 892 | This setting implies that the full power of the reader is in play, 893 | including syntax that can cause code to execute. It should never be 894 | used with untrusted sources. See also: aiba.lein-count.tools-reader.edn/read. 895 | 896 | When set to logical false in the thread-local binding, 897 | the eval reader (#=) and *record/type literal syntax* are disabled in read/load. 898 | Example (will fail): (binding [*read-eval* false] (read-string \"#=(* 2 21)\")) 899 | 900 | When set to :unknown all reads will fail in contexts where *read-eval* 901 | has not been explicitly bound to either true or false. This setting 902 | can be a useful diagnostic tool to ensure that all of your reads 903 | occur in considered contexts." 904 | true) 905 | 906 | (def ^:dynamic *data-readers* 907 | "Map from reader tag symbols to data reader Vars. 908 | Reader tags without namespace qualifiers are reserved for Clojure. 909 | Default reader tags are defined in clojure.tools.reader/default-data-readers 910 | and may be overridden by binding this Var." 911 | {}) 912 | 913 | (def ^:dynamic *default-data-reader-fn* 914 | "When no data reader is found for a tag and *default-data-reader-fn* 915 | is non-nil, it will be called with two arguments, the tag and the value. 916 | If *default-data-reader-fn* is nil (the default value), an exception 917 | will be thrown for the unknown tag." 918 | nil) 919 | 920 | (def ^:dynamic *suppress-read* false) 921 | 922 | (def default-data-readers 923 | "Default map of data reader functions provided by Clojure. 924 | May be overridden by binding *data-readers*" 925 | {'inst #'data-readers/read-instant-date 926 | 'uuid #'data-readers/default-uuid-reader}) 927 | 928 | (defn ^:private read* 929 | ([reader eof-error? sentinel opts pending-forms] 930 | (read* reader eof-error? sentinel nil opts pending-forms)) 931 | ([reader eof-error? sentinel return-on opts pending-forms] 932 | (when (= :unknown *read-eval*) 933 | (reader-error "Reading disallowed - *read-eval* bound to :unknown")) 934 | (try 935 | (loop [] 936 | (log-source reader 937 | (if (seq pending-forms) 938 | (.remove ^List pending-forms 0) 939 | (let [ch (read-char reader)] 940 | (cond 941 | (whitespace? ch) (recur) 942 | (nil? ch) (if eof-error? (reader-error reader "EOF") sentinel) 943 | (= ch return-on) READ_FINISHED 944 | (number-literal? reader ch) (read-number reader ch) 945 | :else (let [f (macros ch)] 946 | (if f 947 | (let [res (f reader ch opts pending-forms)] 948 | (if (identical? res reader) 949 | (recur) 950 | res)) 951 | (read-symbol reader ch)))))))) 952 | (catch Exception e 953 | (if (ex-info? e) 954 | (let [d (ex-data e)] 955 | (if (= :reader-exception (:type d)) 956 | (throw e) 957 | (throw (ex-info (.getMessage e) 958 | (merge {:type :reader-exception} 959 | d 960 | (if (indexing-reader? reader) 961 | {:line (get-line-number reader) 962 | :column (get-column-number reader) 963 | :file (get-file-name reader)})) 964 | e)))) 965 | (throw (ex-info (.getMessage e) 966 | (merge {:type :reader-exception} 967 | (if (indexing-reader? reader) 968 | {:line (get-line-number reader) 969 | :column (get-column-number reader) 970 | :file (get-file-name reader)})) 971 | e))))))) 972 | 973 | (defn read 974 | "Reads the first object from an IPushbackReader or a java.io.PushbackReader. 975 | Returns the object read. If EOF, throws if eof-error? is true. 976 | Otherwise returns sentinel. If no stream is providen, *in* will be used. 977 | 978 | Opts is a persistent map with valid keys: 979 | :read-cond - :allow to process reader conditionals, or 980 | :preserve to keep all branches 981 | :features - persistent set of feature keywords for reader conditionals 982 | :eof - on eof, return value unless :eofthrow, then throw. 983 | if not specified, will throw 984 | 985 | ***WARNING*** 986 | Note that read can execute code (controlled by *read-eval*), 987 | and as such should be used only with trusted sources. 988 | 989 | To read data structures only, use aiba.lein-count.tools-reader.edn/read 990 | 991 | Note that the function signature of clojure.tools.reader/read and 992 | aiba.lein-count.tools-reader.edn/read is not the same for eof-handling" 993 | {:arglists '([] [reader] [opts reader] [reader eof-error? eof-value])} 994 | ([] (read *in* true nil)) 995 | ([reader] (read reader true nil)) 996 | ([{eof :eof :as opts :or {eof :eofthrow}} reader] (read* reader (= eof :eofthrow) eof nil opts (LinkedList.))) 997 | ([reader eof-error? sentinel] (read* reader eof-error? sentinel nil {} (LinkedList.)))) 998 | 999 | (defn read-string 1000 | "Reads one object from the string s. 1001 | Returns nil when s is nil or empty. 1002 | 1003 | ***WARNING*** 1004 | Note that read-string can execute code (controlled by *read-eval*), 1005 | and as such should be used only with trusted sources. 1006 | 1007 | To read data structures only, use aiba.lein-count.tools-reader.edn/read-string 1008 | 1009 | Note that the function signature of clojure.tools.reader/read-string and 1010 | aiba.lein-count.tools-reader.edn/read-string is not the same for eof-handling" 1011 | ([s] 1012 | (read-string {} s)) 1013 | ([opts s] 1014 | (when (and s (not (identical? s ""))) 1015 | (read opts (string-push-back-reader s))))) 1016 | 1017 | (defmacro syntax-quote 1018 | "Macro equivalent to the syntax-quote reader macro (`)." 1019 | [form] 1020 | (binding [gensym-env {}] 1021 | (syntax-quote* form))) 1022 | -------------------------------------------------------------------------------- /src/aiba/lein_count/clojure_tools/reader/default_data_readers.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | ;;; copied from clojure.instant and clojure.uuid ;;; 10 | 11 | (ns ^:skip-wiki aiba.lein-count.clojure-tools.reader.default-data-readers 12 | (:import [java.util Calendar Date GregorianCalendar TimeZone] 13 | [java.sql Timestamp])) 14 | 15 | ;;; clojure.instant ;;; 16 | 17 | ;;; ------------------------------------------------------------------------ 18 | ;;; convenience macros 19 | 20 | (defmacro ^:private fail 21 | [msg] 22 | `(throw (RuntimeException. ~msg))) 23 | 24 | (defmacro ^:private verify 25 | ([test msg] `(when-not ~test (fail ~msg))) 26 | ([test] `(verify ~test ~(str "failed: " (pr-str test))))) 27 | 28 | (defn- divisible? 29 | [num div] 30 | (zero? (mod num div))) 31 | 32 | (defn- indivisible? 33 | [num div] 34 | (not (divisible? num div))) 35 | 36 | 37 | ;;; ------------------------------------------------------------------------ 38 | ;;; parser implementation 39 | 40 | (defn- parse-int [^String s] 41 | (Long/parseLong s)) 42 | 43 | (defn- zero-fill-right [^String s width] 44 | (cond (= width (count s)) s 45 | (< width (count s)) (.substring s 0 width) 46 | :else (loop [b (StringBuilder. s)] 47 | (if (< (.length b) width) 48 | (recur (.append b \0)) 49 | (.toString b))))) 50 | 51 | (def parse-timestamp 52 | "Parse a string containing an RFC3339-like like timestamp. 53 | 54 | The function new-instant is called with the following arguments. 55 | 56 | min max default 57 | --- ------------ ------- 58 | years 0 9999 N/A (s must provide years) 59 | months 1 12 1 60 | days 1 31 1 (actual max days depends 61 | hours 0 23 0 on month and year) 62 | minutes 0 59 0 63 | seconds 0 60 0 (though 60 is only valid 64 | nanoseconds 0 999999999 0 when minutes is 59) 65 | offset-sign -1 1 0 66 | offset-hours 0 23 0 67 | offset-minutes 0 59 0 68 | 69 | These are all integers and will be non-nil. (The listed defaults 70 | will be passed if the corresponding field is not present in s.) 71 | 72 | Grammar (of s): 73 | 74 | date-fullyear = 4DIGIT 75 | date-month = 2DIGIT ; 01-12 76 | date-mday = 2DIGIT ; 01-28, 01-29, 01-30, 01-31 based on 77 | ; month/year 78 | time-hour = 2DIGIT ; 00-23 79 | time-minute = 2DIGIT ; 00-59 80 | time-second = 2DIGIT ; 00-58, 00-59, 00-60 based on leap second 81 | ; rules 82 | time-secfrac = '.' 1*DIGIT 83 | time-numoffset = ('+' / '-') time-hour ':' time-minute 84 | time-offset = 'Z' / time-numoffset 85 | 86 | time-part = time-hour [ ':' time-minute [ ':' time-second 87 | [time-secfrac] [time-offset] ] ] 88 | 89 | timestamp = date-year [ '-' date-month [ '-' date-mday 90 | [ 'T' time-part ] ] ] 91 | 92 | Unlike RFC3339: 93 | 94 | - we only parse the timestamp format 95 | - timestamp can elide trailing components 96 | - time-offset is optional (defaults to +00:00) 97 | 98 | Though time-offset is syntactically optional, a missing time-offset 99 | will be treated as if the time-offset zero (+00:00) had been 100 | specified. 101 | " 102 | (let [timestamp #"(\d\d\d\d)(?:-(\d\d)(?:-(\d\d)(?:[T](\d\d)(?::(\d\d)(?::(\d\d)(?:[.](\d+))?)?)?)?)?)?(?:[Z]|([-+])(\d\d):(\d\d))?"] 103 | 104 | (fn [new-instant ^CharSequence cs] 105 | (if-let [[_ years months days hours minutes seconds fraction 106 | offset-sign offset-hours offset-minutes] 107 | (re-matches timestamp cs)] 108 | (new-instant 109 | (parse-int years) 110 | (if-not months 1 (parse-int months)) 111 | (if-not days 1 (parse-int days)) 112 | (if-not hours 0 (parse-int hours)) 113 | (if-not minutes 0 (parse-int minutes)) 114 | (if-not seconds 0 (parse-int seconds)) 115 | (if-not fraction 0 (parse-int (zero-fill-right fraction 9))) 116 | (cond (= "-" offset-sign) -1 117 | (= "+" offset-sign) 1 118 | :else 0) 119 | (if-not offset-hours 0 (parse-int offset-hours)) 120 | (if-not offset-minutes 0 (parse-int offset-minutes))) 121 | (fail (str "Unrecognized date/time syntax: " cs)))))) 122 | 123 | 124 | ;;; ------------------------------------------------------------------------ 125 | ;;; Verification of Extra-Grammatical Restrictions from RFC3339 126 | 127 | (defn- leap-year? 128 | [year] 129 | (and (divisible? year 4) 130 | (or (indivisible? year 100) 131 | (divisible? year 400)))) 132 | 133 | (def ^:private days-in-month 134 | (let [dim-norm [nil 31 28 31 30 31 30 31 31 30 31 30 31] 135 | dim-leap [nil 31 29 31 30 31 30 31 31 30 31 30 31]] 136 | (fn [month leap-year?] 137 | ((if leap-year? dim-leap dim-norm) month)))) 138 | 139 | (defn validated 140 | "Return a function which constructs and instant by calling constructor 141 | after first validating that those arguments are in range and otherwise 142 | plausible. The resulting function will throw an exception if called 143 | with invalid arguments." 144 | [new-instance] 145 | (fn [years months days hours minutes seconds nanoseconds 146 | offset-sign offset-hours offset-minutes] 147 | (verify (<= 1 months 12)) 148 | (verify (<= 1 days (days-in-month months (leap-year? years)))) 149 | (verify (<= 0 hours 23)) 150 | (verify (<= 0 minutes 59)) 151 | (verify (<= 0 seconds (if (= minutes 59) 60 59))) 152 | (verify (<= 0 nanoseconds 999999999)) 153 | (verify (<= -1 offset-sign 1)) 154 | (verify (<= 0 offset-hours 23)) 155 | (verify (<= 0 offset-minutes 59)) 156 | (new-instance years months days hours minutes seconds nanoseconds 157 | offset-sign offset-hours offset-minutes))) 158 | 159 | 160 | ;;; ------------------------------------------------------------------------ 161 | ;;; print integration 162 | 163 | (def ^:private ^ThreadLocal thread-local-utc-date-format 164 | ;; SimpleDateFormat is not thread-safe, so we use a ThreadLocal proxy for access. 165 | ;; http://bugs.sun.com/bugdatabase/view_bug.do?bug_id=4228335 166 | (proxy [ThreadLocal] [] 167 | (initialValue [] 168 | (doto (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss.SSS-00:00") 169 | ;; RFC3339 says to use -00:00 when the timezone is unknown (+00:00 implies a known GMT) 170 | (.setTimeZone (java.util.TimeZone/getTimeZone "GMT")))))) 171 | 172 | (defn- print-date 173 | "Print a java.util.Date as RFC3339 timestamp, always in UTC." 174 | [^java.util.Date d, ^java.io.Writer w] 175 | (let [utc-format (.get thread-local-utc-date-format)] 176 | (.write w "#inst \"") 177 | (.write w ^String (.format ^java.text.SimpleDateFormat utc-format d)) 178 | (.write w "\""))) 179 | 180 | (defmethod print-method java.util.Date 181 | [^java.util.Date d, ^java.io.Writer w] 182 | (print-date d w)) 183 | 184 | (defmethod print-dup java.util.Date 185 | [^java.util.Date d, ^java.io.Writer w] 186 | (print-date d w)) 187 | 188 | (defn- print-calendar 189 | "Print a java.util.Calendar as RFC3339 timestamp, preserving timezone." 190 | [^java.util.Calendar c, ^java.io.Writer w] 191 | (let [calstr (format "%1$tFT%1$tT.%1$tL%1$tz" c) 192 | offset-minutes (- (.length calstr) 2)] 193 | ;; calstr is almost right, but is missing the colon in the offset 194 | (.write w "#inst \"") 195 | (.write w calstr 0 offset-minutes) 196 | (.write w ":") 197 | (.write w calstr offset-minutes 2) 198 | (.write w "\""))) 199 | 200 | (defmethod print-method java.util.Calendar 201 | [^java.util.Calendar c, ^java.io.Writer w] 202 | (print-calendar c w)) 203 | 204 | (defmethod print-dup java.util.Calendar 205 | [^java.util.Calendar c, ^java.io.Writer w] 206 | (print-calendar c w)) 207 | 208 | 209 | (def ^:private ^ThreadLocal thread-local-utc-timestamp-format 210 | ;; SimpleDateFormat is not thread-safe, so we use a ThreadLocal proxy for access. 211 | ;; http://bugs.sun.com/bugdatabase/view_bug.do?bug_id=4228335 212 | (proxy [ThreadLocal] [] 213 | (initialValue [] 214 | (doto (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss") 215 | (.setTimeZone (java.util.TimeZone/getTimeZone "GMT")))))) 216 | 217 | (defn- print-timestamp 218 | "Print a java.sql.Timestamp as RFC3339 timestamp, always in UTC." 219 | [^java.sql.Timestamp ts, ^java.io.Writer w] 220 | (let [utc-format (.get thread-local-utc-timestamp-format)] 221 | (.write w "#inst \"") 222 | (.write w ^String (.format ^java.text.SimpleDateFormat utc-format ts)) 223 | ;; add on nanos and offset 224 | ;; RFC3339 says to use -00:00 when the timezone is unknown (+00:00 implies a known GMT) 225 | (.write w (format ".%09d-00:00" (.getNanos ts))) 226 | (.write w "\""))) 227 | 228 | (defmethod print-method java.sql.Timestamp 229 | [^java.sql.Timestamp ts, ^java.io.Writer w] 230 | (print-timestamp ts w)) 231 | 232 | (defmethod print-dup java.sql.Timestamp 233 | [^java.sql.Timestamp ts, ^java.io.Writer w] 234 | (print-timestamp ts w)) 235 | 236 | 237 | ;;; ------------------------------------------------------------------------ 238 | ;;; reader integration 239 | 240 | (defn- construct-calendar 241 | "Construct a java.util.Calendar, preserving the timezone 242 | offset, but truncating the subsecond fraction to milliseconds." 243 | ^GregorianCalendar 244 | [years months days hours minutes seconds nanoseconds 245 | offset-sign offset-hours offset-minutes] 246 | (doto (GregorianCalendar. years (dec months) days hours minutes seconds) 247 | (.set Calendar/MILLISECOND (quot nanoseconds 1000000)) 248 | (.setTimeZone (TimeZone/getTimeZone 249 | (format "GMT%s%02d:%02d" 250 | (if (neg? offset-sign) "-" "+") 251 | offset-hours offset-minutes))))) 252 | 253 | (defn- construct-date 254 | "Construct a java.util.Date, which expresses the original instant as 255 | milliseconds since the epoch, UTC." 256 | [years months days hours minutes seconds nanoseconds 257 | offset-sign offset-hours offset-minutes] 258 | (.getTime (construct-calendar years months days 259 | hours minutes seconds nanoseconds 260 | offset-sign offset-hours offset-minutes))) 261 | 262 | (defn- construct-timestamp 263 | "Construct a java.sql.Timestamp, which has nanosecond precision." 264 | [years months days hours minutes seconds nanoseconds 265 | offset-sign offset-hours offset-minutes] 266 | (doto (Timestamp. 267 | (.getTimeInMillis 268 | (construct-calendar years months days 269 | hours minutes seconds 0 270 | offset-sign offset-hours offset-minutes))) 271 | ;; nanos must be set separately, pass 0 above for the base calendar 272 | (.setNanos nanoseconds))) 273 | 274 | (def read-instant-date 275 | "To read an instant as a java.util.Date, bind *data-readers* to a map with 276 | this var as the value for the 'inst key. The timezone offset will be used 277 | to convert into UTC." 278 | (partial parse-timestamp (validated construct-date))) 279 | 280 | (def read-instant-calendar 281 | "To read an instant as a java.util.Calendar, bind *data-readers* to a map with 282 | this var as the value for the 'inst key. Calendar preserves the timezone 283 | offset." 284 | (partial parse-timestamp (validated construct-calendar))) 285 | 286 | (def read-instant-timestamp 287 | "To read an instant as a java.sql.Timestamp, bind *data-readers* to a 288 | map with this var as the value for the 'inst key. Timestamp preserves 289 | fractional seconds with nanosecond precision. The timezone offset will 290 | be used to convert into UTC." 291 | (partial parse-timestamp (validated construct-timestamp))) 292 | 293 | ;;; clojure.uuid ;;; 294 | 295 | (defn default-uuid-reader [form] 296 | {:pre [(string? form)]} 297 | (java.util.UUID/fromString form)) 298 | 299 | (defmethod print-method java.util.UUID [uuid ^java.io.Writer w] 300 | (.write w (str "#uuid \"" (str uuid) "\""))) 301 | 302 | (defmethod print-dup java.util.UUID [o w] 303 | (print-method o w)) 304 | -------------------------------------------------------------------------------- /src/aiba/lein_count/clojure_tools/reader/edn.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:doc "An EDN reader in clojure" 10 | :author "Bronsa"} 11 | aiba.lein-count.clojure-tools.reader.edn 12 | (:refer-clojure :exclude [read read-string char default-data-readers]) 13 | (:require [aiba.lein-count.clojure-tools.reader.reader-types :refer 14 | [read-char reader-error unread peek-char indexing-reader? 15 | get-line-number get-column-number get-file-name string-push-back-reader]] 16 | [aiba.lein-count.clojure-tools.reader.impl.utils :refer 17 | [char ex-info? whitespace? numeric? desugar-meta namespace-keys second']] 18 | [aiba.lein-count.clojure-tools.reader.impl.commons :refer :all] 19 | [aiba.lein-count.clojure-tools.reader :refer [default-data-readers]]) 20 | (:import (clojure.lang PersistentHashSet IMeta RT PersistentVector))) 21 | 22 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 23 | ;; helpers 24 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 25 | 26 | (declare read macros dispatch-macros) 27 | 28 | (defn- macro-terminating? [ch] 29 | (and (not (identical? \# ch)) 30 | (not (identical? \' ch)) 31 | (not (identical? \: ch)) 32 | (macros ch))) 33 | 34 | (defn- not-constituent? [ch] 35 | (or (identical? \@ ch) 36 | (identical? \` ch) 37 | (identical? \~ ch))) 38 | 39 | (defn- ^String read-token 40 | ([rdr initch] 41 | (read-token rdr initch true)) 42 | ([rdr initch validate-leading?] 43 | (cond 44 | (not initch) 45 | (reader-error rdr "EOF while reading") 46 | 47 | (and validate-leading? 48 | (not-constituent? initch)) 49 | (reader-error rdr "Invalid leading character: " initch) 50 | 51 | :else 52 | (loop [sb (StringBuilder.) 53 | ch (do (unread rdr initch) initch)] 54 | (if (or (whitespace? ch) 55 | (macro-terminating? ch) 56 | (nil? ch)) 57 | (str sb) 58 | (if (not-constituent? ch) 59 | (reader-error rdr "Invalid constituent character: " ch) 60 | (recur (doto sb (.append (read-char rdr))) (peek-char rdr)))))))) 61 | 62 | (declare read-tagged) 63 | 64 | (defn- read-dispatch 65 | [rdr _ opts] 66 | (if-let [ch (read-char rdr)] 67 | (if-let [dm (dispatch-macros ch)] 68 | (dm rdr ch opts) 69 | (if-let [obj (read-tagged (doto rdr (unread ch)) ch opts)] 70 | obj 71 | (reader-error rdr "No dispatch macro for " ch))) 72 | (reader-error rdr "EOF while reading character"))) 73 | 74 | (defn- read-unmatched-delimiter 75 | [rdr ch opts] 76 | (reader-error rdr "Unmatched delimiter " ch)) 77 | 78 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 79 | ;; readers 80 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 81 | 82 | (defn- read-unicode-char 83 | ([^String token ^long offset ^long length ^long base] 84 | (let [l (+ offset length)] 85 | (when-not (== (count token) l) 86 | (throw (IllegalArgumentException. (str "Invalid unicode character: \\" token)))) 87 | (loop [i offset uc 0] 88 | (if (== i l) 89 | (char uc) 90 | (let [d (Character/digit (int (nth token i)) (int base))] 91 | (if (== d -1) 92 | (throw (IllegalArgumentException. (str "Invalid digit: " (nth token i)))) 93 | (recur (inc i) (long (+ d (* uc base)))))))))) 94 | 95 | ([rdr initch base length exact?] 96 | (let [length (long length) 97 | base (long base)] 98 | (loop [i 1 uc (Character/digit (int initch) (int base))] 99 | (if (== uc -1) 100 | (throw (IllegalArgumentException. (str "Invalid digit: " initch))) 101 | (if-not (== i length) 102 | (let [ch (peek-char rdr)] 103 | (if (or (whitespace? ch) 104 | (macros ch) 105 | (nil? ch)) 106 | (if exact? 107 | (throw (IllegalArgumentException. 108 | (str "Invalid character length: " i ", should be: " length))) 109 | (char uc)) 110 | (let [d (Character/digit (int ch) (int base))] 111 | (read-char rdr) 112 | (if (== d -1) 113 | (throw (IllegalArgumentException. (str "Invalid digit: " ch))) 114 | (recur (inc i) (long (+ d (* uc base)))))))) 115 | (char uc))))))) 116 | 117 | (def ^:private ^:const upper-limit (int \uD7ff)) 118 | (def ^:private ^:const lower-limit (int \uE000)) 119 | 120 | (defn- read-char* 121 | [rdr backslash opts] 122 | (let [ch (read-char rdr)] 123 | (if-not (nil? ch) 124 | (let [token (if (or (macro-terminating? ch) 125 | (not-constituent? ch) 126 | (whitespace? ch)) 127 | (str ch) 128 | (read-token rdr ch false)) 129 | token-len (count token)] 130 | (cond 131 | 132 | (== 1 token-len) (Character/valueOf (nth token 0)) 133 | 134 | (= token "newline") \newline 135 | (= token "space") \space 136 | (= token "tab") \tab 137 | (= token "backspace") \backspace 138 | (= token "formfeed") \formfeed 139 | (= token "return") \return 140 | 141 | (.startsWith token "u") 142 | (let [c (read-unicode-char token 1 4 16) 143 | ic (int c)] 144 | (if (and (> ic upper-limit) 145 | (< ic lower-limit)) 146 | (reader-error rdr "Invalid character constant: \\u" (Integer/toString ic 16)) 147 | c)) 148 | 149 | (.startsWith token "o") 150 | (let [len (dec token-len)] 151 | (if (> len 3) 152 | (reader-error rdr "Invalid octal escape sequence length: " len) 153 | (let [uc (read-unicode-char token 1 len 8)] 154 | (if (> (int uc) 0377) 155 | (reader-error rdr "Octal escape sequence must be in range [0, 377]") 156 | uc)))) 157 | 158 | :else (reader-error rdr "Unsupported character: \\" token))) 159 | (reader-error rdr "EOF while reading character")))) 160 | 161 | (defn- ^PersistentVector read-delimited 162 | [delim rdr opts] 163 | (let [first-line (when (indexing-reader? rdr) 164 | (get-line-number rdr)) 165 | delim (char delim)] 166 | (loop [a (transient [])] 167 | (let [ch (read-past whitespace? rdr)] 168 | (when-not ch 169 | (reader-error rdr "EOF while reading" 170 | (if first-line 171 | (str ", starting at line" first-line)))) 172 | (if (identical? delim (char ch)) 173 | (persistent! a) 174 | (if-let [macrofn (macros ch)] 175 | (let [mret (macrofn rdr ch opts)] 176 | (recur (if-not (identical? mret rdr) (conj! a mret) a))) 177 | (let [o (read (doto rdr (unread ch)) true nil opts)] 178 | (recur (if-not (identical? o rdr) (conj! a o) a))))))))) 179 | 180 | (defn- read-list 181 | [rdr _ opts] 182 | (let [the-list (read-delimited \) rdr opts)] 183 | (if (empty? the-list) 184 | '() 185 | (clojure.lang.PersistentList/create the-list)))) 186 | 187 | (defn- read-vector 188 | [rdr _ opts] 189 | (read-delimited \] rdr opts)) 190 | 191 | (defn- read-map 192 | [rdr _ opts] 193 | (let [l (to-array (read-delimited \} rdr opts))] 194 | (when (== 1 (bit-and (alength l) 1)) 195 | (reader-error rdr "Map literal must contain an even number of forms")) 196 | (RT/map l))) 197 | 198 | (defn- read-number 199 | [reader initch opts] 200 | (loop [sb (doto (StringBuilder.) (.append initch)) 201 | ch (read-char reader)] 202 | (if (or (whitespace? ch) (macros ch) (nil? ch)) 203 | (let [s (str sb)] 204 | (unread reader ch) 205 | (or (match-number s) 206 | (reader-error reader "Invalid number format [" s "]"))) 207 | (recur (doto sb (.append ch)) (read-char reader))))) 208 | 209 | (defn- escape-char [sb rdr] 210 | (let [ch (read-char rdr)] 211 | (case ch 212 | \t "\t" 213 | \r "\r" 214 | \n "\n" 215 | \\ "\\" 216 | \" "\"" 217 | \b "\b" 218 | \f "\f" 219 | \u (let [ch (read-char rdr)] 220 | (if (== -1 (Character/digit (int ch) 16)) 221 | (reader-error rdr "Invalid unicode escape: \\u" ch) 222 | (read-unicode-char rdr ch 16 4 true))) 223 | (if (numeric? ch) 224 | (let [ch (read-unicode-char rdr ch 8 3 false)] 225 | (if (> (int ch) 0337) 226 | (reader-error rdr "Octal escape sequence must be in range [0, 377]") 227 | ch)) 228 | (reader-error rdr "Unsupported escape character: \\" ch))))) 229 | 230 | (defn- read-string* 231 | [reader _ opts] 232 | (loop [sb (StringBuilder.) 233 | ch (read-char reader)] 234 | (case ch 235 | nil (reader-error reader "EOF while reading string") 236 | \\ (recur (doto sb (.append (escape-char sb reader))) 237 | (read-char reader)) 238 | \" (str sb) 239 | (recur (doto sb (.append ch)) (read-char reader))))) 240 | 241 | (defn- read-symbol 242 | [rdr initch] 243 | (when-let [token (read-token rdr initch)] 244 | (case token 245 | 246 | ;; special symbols 247 | "nil" nil 248 | "true" true 249 | "false" false 250 | "/" '/ 251 | "NaN" Double/NaN 252 | "-Infinity" Double/NEGATIVE_INFINITY 253 | ("Infinity" "+Infinity") Double/POSITIVE_INFINITY 254 | 255 | (or (when-let [p (parse-symbol token)] 256 | (symbol (p 0) (p 1))) 257 | (reader-error rdr "Invalid token: " token))))) 258 | 259 | (defn- read-keyword 260 | [reader initch opts] 261 | (let [ch (read-char reader)] 262 | (if-not (whitespace? ch) 263 | (let [token (read-token reader ch) 264 | s (parse-symbol token)] 265 | (if (and s (== -1 (.indexOf token "::"))) 266 | (let [^String ns (s 0) 267 | ^String name (s 1)] 268 | (if (identical? \: (nth token 0)) 269 | (reader-error reader "Invalid token: :" token) ;; no ::keyword in edn 270 | (keyword ns name))) 271 | (reader-error reader "Invalid token: :" token))) 272 | (reader-error reader "Invalid token: :")))) 273 | 274 | (defn- wrapping-reader 275 | [sym] 276 | (fn [rdr _ opts] 277 | (list sym (read rdr true nil opts)))) 278 | 279 | (defn- read-meta 280 | [rdr _ opts] 281 | (let [m (desugar-meta (read rdr true nil opts))] 282 | (when-not (map? m) 283 | (reader-error rdr "Metadata must be Symbol, Keyword, String or Map")) 284 | (let [o (read rdr true nil opts)] 285 | (if (instance? IMeta o) 286 | (with-meta o (merge (meta o) m)) 287 | (reader-error rdr "Metadata can only be applied to IMetas"))))) 288 | 289 | (defn- read-set 290 | [rdr _ opts] 291 | (PersistentHashSet/createWithCheck (read-delimited \} rdr opts))) 292 | 293 | (defn- read-discard 294 | [rdr _ opts] 295 | (doto rdr 296 | (read true nil true))) 297 | 298 | (defn- read-namespaced-map 299 | [rdr _ opts] 300 | (let [token (read-token rdr (read-char rdr))] 301 | (if-let [ns (some-> token parse-symbol second')] 302 | (let [ch (read-past whitespace? rdr)] 303 | (if (identical? ch \{) 304 | (let [items (read-delimited \} rdr opts)] 305 | (when (odd? (count items)) 306 | (reader-error rdr "Map literal must contain an even number of forms")) 307 | (let [keys (take-nth 2 items) 308 | vals (take-nth 2 (rest items))] 309 | (zipmap (namespace-keys (str ns) keys) vals))) 310 | (reader-error rdr "Namespaced map must specify a map"))) 311 | (reader-error rdr "Invalid token used as namespace in namespaced map: " token)))) 312 | 313 | (defn- macros [ch] 314 | (case ch 315 | \" read-string* 316 | \: read-keyword 317 | \; read-comment 318 | \^ read-meta 319 | \( read-list 320 | \) read-unmatched-delimiter 321 | \[ read-vector 322 | \] read-unmatched-delimiter 323 | \{ read-map 324 | \} read-unmatched-delimiter 325 | \\ read-char* 326 | \# read-dispatch 327 | nil)) 328 | 329 | (defn- dispatch-macros [ch] 330 | (case ch 331 | \^ read-meta ;deprecated 332 | \{ read-set 333 | \< (throwing-reader "Unreadable form") 334 | \! read-comment 335 | \_ read-discard 336 | \: read-namespaced-map 337 | nil)) 338 | 339 | (defn- read-tagged [rdr initch opts] 340 | (let [tag (read rdr true nil opts) 341 | object (read rdr true nil opts)] 342 | (if-not (symbol? tag) 343 | (reader-error rdr "Reader tag must be a symbol")) 344 | (if-let [f (or (get (:readers opts) tag) 345 | (default-data-readers tag))] 346 | (f object) 347 | (if-let [d (:default opts)] 348 | (d tag object) 349 | (reader-error rdr "No reader function for tag " (name tag)))))) 350 | 351 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 352 | ;; Public API 353 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 354 | 355 | (defn read 356 | "Reads the first object from an IPushbackReader or a java.io.PushbackReader. 357 | Returns the object read. If EOF, throws if eof-error? is true otherwise returns eof. 358 | If no reader is provided, *in* will be used. 359 | 360 | Reads data in the edn format (subset of Clojure data): 361 | http://edn-format.org 362 | 363 | aiba.lein-count.tools-reader.edn/read doesn't depend on dynamic Vars, all configuration 364 | is done by passing an opt map. 365 | 366 | opts is a map that can include the following keys: 367 | :eof - value to return on end-of-file. When not supplied, eof throws an exception. 368 | :readers - a map of tag symbols to data-reader functions to be considered before default-data-readers. 369 | When not supplied, only the default-data-readers will be used. 370 | :default - A function of two args, that will, if present and no reader is found for a tag, 371 | be called with the tag and the value." 372 | ([] (read *in*)) 373 | ([reader] (read {} reader)) 374 | ([{:keys [eof] :as opts} reader] 375 | (let [eof-error? (not (contains? opts :eof))] 376 | (read reader eof-error? eof opts))) 377 | ([reader eof-error? eof opts] 378 | (try 379 | (loop [] 380 | (let [ch (read-char reader)] 381 | (cond 382 | (whitespace? ch) (recur) 383 | (nil? ch) (if eof-error? (reader-error reader "EOF") eof) 384 | (number-literal? reader ch) (read-number reader ch opts) 385 | :else (let [f (macros ch)] 386 | (if f 387 | (let [res (f reader ch opts)] 388 | (if (identical? res reader) 389 | (recur) 390 | res)) 391 | (read-symbol reader ch)))))) 392 | (catch Exception e 393 | (if (ex-info? e) 394 | (let [d (ex-data e)] 395 | (if (= :reader-exception (:type d)) 396 | (throw e) 397 | (throw (ex-info (.getMessage e) 398 | (merge {:type :reader-exception} 399 | d 400 | (if (indexing-reader? reader) 401 | {:line (get-line-number reader) 402 | :column (get-column-number reader) 403 | :file (get-file-name reader)})) 404 | e)))) 405 | (throw (ex-info (.getMessage e) 406 | (merge {:type :reader-exception} 407 | (if (indexing-reader? reader) 408 | {:line (get-line-number reader) 409 | :column (get-column-number reader) 410 | :file (get-file-name reader)})) 411 | e))))))) 412 | 413 | (defn read-string 414 | "Reads one object from the string s. 415 | Returns nil when s is nil or empty. 416 | 417 | Reads data in the edn format (subset of Clojure data): 418 | http://edn-format.org 419 | 420 | opts is a map as per aiba.lein-count.tools-reader.edn/read" 421 | ([s] (read-string {:eof nil} s)) 422 | ([opts s] 423 | (when (and s (not (identical? s ""))) 424 | (read opts (string-push-back-reader s))))) 425 | -------------------------------------------------------------------------------- /src/aiba/lein_count/clojure_tools/reader/impl/commons.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns aiba.lein-count.clojure-tools.reader.impl.commons 10 | (:refer-clojure :exclude [char]) 11 | (:require [aiba.lein-count.clojure-tools.reader.reader-types :refer [peek-char read-char reader-error]] 12 | [aiba.lein-count.clojure-tools.reader.impl.utils :refer [numeric? newline? char]]) 13 | (:import (clojure.lang BigInt Numbers) 14 | (java.util.regex Pattern Matcher) 15 | java.lang.reflect.Constructor)) 16 | 17 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 18 | ;; helpers 19 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 20 | 21 | (defn number-literal? 22 | "Checks whether the reader is at the start of a number literal" 23 | [reader initch] 24 | (or (numeric? initch) 25 | (and (or (identical? \+ initch) (identical? \- initch)) 26 | (numeric? (peek-char reader))))) 27 | 28 | (defn read-past 29 | "Read until first character that doesn't match pred, returning 30 | char." 31 | [pred rdr] 32 | (loop [ch (read-char rdr)] 33 | (if (pred ch) 34 | (recur (read-char rdr)) 35 | ch))) 36 | 37 | (defn skip-line 38 | "Advances the reader to the end of a line. Returns the reader" 39 | [reader] 40 | (loop [] 41 | (when-not (newline? (read-char reader)) 42 | (recur))) 43 | reader) 44 | 45 | (def ^Pattern int-pattern #"([-+]?)(?:(0)|([1-9][0-9]*)|0[xX]([0-9A-Fa-f]+)|0([0-7]+)|([1-9][0-9]?)[rR]([0-9A-Za-z]+)|0[0-9]+)(N)?") 46 | (def ^Pattern ratio-pattern #"([-+]?[0-9]+)/([0-9]+)") 47 | (def ^Pattern float-pattern #"([-+]?[0-9]+(\.[0-9]*)?([eE][-+]?[0-9]+)?)(M)?") 48 | 49 | (defn- match-int 50 | [^Matcher m] 51 | (if (.group m 2) 52 | (if (.group m 8) 0N 0) 53 | (let [negate? (= "-" (.group m 1)) 54 | a (cond 55 | (.group m 3) [(.group m 3) 10] 56 | (.group m 4) [(.group m 4) 16] 57 | (.group m 5) [(.group m 5) 8] 58 | (.group m 7) [(.group m 7) (Integer/parseInt (.group m 6))] 59 | :else [nil nil]) 60 | ^String n (a 0)] 61 | (when n 62 | (let [bn (BigInteger. n (int (a 1))) 63 | bn (if negate? (.negate bn) bn)] 64 | (if (.group m 8) 65 | (BigInt/fromBigInteger bn) 66 | (if (< (.bitLength bn) 64) 67 | (.longValue bn) 68 | (BigInt/fromBigInteger bn)))))))) 69 | 70 | (defn- match-ratio 71 | [^Matcher m] 72 | (let [^String numerator (.group m 1) 73 | ^String denominator (.group m 2) 74 | numerator (if (.startsWith numerator "+") 75 | (subs numerator 1) 76 | numerator)] 77 | (/ (-> numerator BigInteger. BigInt/fromBigInteger Numbers/reduceBigInt) 78 | (-> denominator BigInteger. BigInt/fromBigInteger Numbers/reduceBigInt)))) 79 | 80 | (defn- match-float 81 | [^String s ^Matcher m] 82 | (if (.group m 4) 83 | (BigDecimal. ^String (.group m 1)) 84 | (Double/parseDouble s))) 85 | 86 | (defn match-number [^String s] 87 | (let [int-matcher (.matcher int-pattern s)] 88 | (if (.matches int-matcher) 89 | (match-int int-matcher) 90 | (let [float-matcher (.matcher float-pattern s)] 91 | (if (.matches float-matcher) 92 | (match-float s float-matcher) 93 | (let [ratio-matcher (.matcher ratio-pattern s)] 94 | (when (.matches ratio-matcher) 95 | (match-ratio ratio-matcher)))))))) 96 | 97 | (defn parse-symbol 98 | "Parses a string into a vector of the namespace and symbol" 99 | [^String token] 100 | (when-not (or (= "" token) 101 | (.endsWith token ":") 102 | (.startsWith token "::")) 103 | (let [ns-idx (.indexOf token "/")] 104 | (if-let [^String ns (and (pos? ns-idx) 105 | (subs token 0 ns-idx))] 106 | (let [ns-idx (inc ns-idx)] 107 | (when-not (== ns-idx (count token)) 108 | (let [sym (subs token ns-idx)] 109 | (when (and (not (numeric? (nth sym 0))) 110 | (not (= "" sym)) 111 | (not (.endsWith ns ":")) 112 | (or (= sym "/") 113 | (== -1 (.indexOf sym "/")))) 114 | [ns sym])))) 115 | (when (or (= token "/") 116 | (== -1 (.indexOf token "/"))) 117 | [nil token]))))) 118 | 119 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 120 | ;; readers 121 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 122 | 123 | (defn read-comment 124 | [rdr & _] 125 | (skip-line rdr)) 126 | 127 | (defn throwing-reader 128 | [msg] 129 | (fn [rdr & _] 130 | (reader-error rdr msg))) 131 | -------------------------------------------------------------------------------- /src/aiba/lein_count/clojure_tools/reader/impl/utils.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^:skip-wiki aiba.lein-count.clojure-tools.reader.impl.utils 10 | (:refer-clojure :exclude [char])) 11 | 12 | (defn char [x] 13 | (when x 14 | (clojure.core/char x))) 15 | 16 | (def <=clojure-1-7-alpha5 17 | (let [{:keys [minor qualifier]} *clojure-version*] 18 | (or (< minor 7) 19 | (and (= minor 7) 20 | (= "alpha" 21 | (when qualifier 22 | (subs qualifier 0 (dec (count qualifier))))) 23 | (<= (read-string (subs qualifier (dec (count qualifier)))) 24 | 5))))) 25 | 26 | (defmacro compile-when [cond & then] 27 | (when (eval cond) 28 | `(do ~@then))) 29 | 30 | (defn ex-info? [ex] 31 | (instance? clojure.lang.ExceptionInfo ex)) 32 | 33 | (compile-when <=clojure-1-7-alpha5 34 | (defrecord TaggedLiteral [tag form]) 35 | 36 | (defn tagged-literal? 37 | "Return true if the value is the data representation of a tagged literal" 38 | [value] 39 | (instance? aiba.lein_count.clojure_tools.reader.impl.utils.TaggedLiteral value)) 40 | 41 | (defn tagged-literal 42 | "Construct a data representation of a tagged literal from a 43 | tag symbol and a form." 44 | [tag form] 45 | (aiba.lein_count.clojure_tools.reader.impl.utils.TaggedLiteral. tag form)) 46 | 47 | (ns-unmap *ns* '->TaggedLiteral) 48 | (ns-unmap *ns* 'map->TaggedLiteral) 49 | 50 | (defmethod print-method aiba.lein_count.clojure_tools.reader.impl.utils.TaggedLiteral [o ^java.io.Writer w] 51 | (.write w "#") 52 | (print-method (:tag o) w) 53 | (.write w " ") 54 | (print-method (:form o) w)) 55 | 56 | (defrecord ReaderConditional [splicing? form]) 57 | (ns-unmap *ns* '->ReaderConditional) 58 | (ns-unmap *ns* 'map->ReaderConditional) 59 | 60 | (defn reader-conditional? 61 | "Return true if the value is the data representation of a reader conditional" 62 | [value] 63 | (instance? aiba.lein_count.clojure_tools.reader.impl.utils.ReaderConditional value)) 64 | 65 | (defn reader-conditional 66 | "Construct a data representation of a reader conditional. 67 | If true, splicing? indicates read-cond-splicing." 68 | [form splicing?] 69 | (aiba.lein_count.clojure_tools.reader.impl.utils.ReaderConditional. splicing? form)) 70 | 71 | (defmethod print-method aiba.lein_count.clojure_tools.reader.impl.utils.ReaderConditional [o ^java.io.Writer w] 72 | (.write w "#?") 73 | (when (:splicing? o) (.write w "@")) 74 | (print-method (:form o) w))) 75 | 76 | (defn whitespace? 77 | "Checks whether a given character is whitespace" 78 | [ch] 79 | (when ch 80 | (or (Character/isWhitespace ^Character ch) 81 | (identical? \, ch)))) 82 | 83 | (defn numeric? 84 | "Checks whether a given character is numeric" 85 | [^Character ch] 86 | (when ch 87 | (Character/isDigit ch))) 88 | 89 | (defn newline? 90 | "Checks whether the character is a newline" 91 | [c] 92 | (or (identical? \newline c) 93 | (nil? c))) 94 | 95 | (defn desugar-meta 96 | "Resolves syntactical sugar in metadata" ;; could be combined with some other desugar? 97 | [f] 98 | (cond 99 | (keyword? f) {f true} 100 | (symbol? f) {:tag f} 101 | (string? f) {:tag f} 102 | :else f)) 103 | 104 | (defn make-var 105 | "Returns an anonymous unbound Var" 106 | [] 107 | (with-local-vars [x nil] x)) 108 | 109 | (defn namespace-keys [ns keys] 110 | (for [key keys] 111 | (if (or (symbol? key) 112 | (keyword? key)) 113 | (let [[key-ns key-name] ((juxt namespace name) key) 114 | ->key (if (symbol? key) symbol keyword)] 115 | (cond 116 | (nil? key-ns) 117 | (->key ns key-name) 118 | 119 | (= "_" key-ns) 120 | (->key key-name) 121 | 122 | :else 123 | key)) 124 | key))) 125 | 126 | (defn second' [[a b]] 127 | (when-not a b)) 128 | -------------------------------------------------------------------------------- /src/aiba/lein_count/clojure_tools/reader/reader_types.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:doc "Protocols and default Reader types implementation" 10 | :author "Bronsa"} 11 | aiba.lein-count.clojure-tools.reader.reader-types 12 | (:refer-clojure :exclude [char read-line]) 13 | (:require [aiba.lein-count.clojure-tools.reader.impl.utils :refer 14 | [char whitespace? newline? make-var]]) 15 | (:import clojure.lang.LineNumberingPushbackReader 16 | (java.io InputStream BufferedReader Closeable))) 17 | 18 | (defmacro ^:private update! [what f] 19 | (list 'set! what (list f what))) 20 | 21 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 22 | ;; reader protocols 23 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 24 | 25 | (defprotocol Reader 26 | (read-char [reader] 27 | "Returns the next char from the Reader, nil if the end of stream has been reached") 28 | (peek-char [reader] 29 | "Returns the next char from the Reader without removing it from the reader stream")) 30 | 31 | (defprotocol IPushbackReader 32 | (unread [reader ch] 33 | "Pushes back a single character on to the stream")) 34 | 35 | (defprotocol IndexingReader 36 | (get-line-number [reader] 37 | "Returns the line number of the next character to be read from the stream") 38 | (get-column-number [reader] 39 | "Returns the column number of the next character to be read from the stream") 40 | (get-file-name [reader] 41 | "Returns the file name the reader is reading from, or nil")) 42 | 43 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 44 | ;; reader deftypes 45 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 46 | 47 | (deftype StringReader 48 | [^String s ^long s-len ^:unsynchronized-mutable ^long s-pos] 49 | Reader 50 | (read-char [reader] 51 | (when (> s-len s-pos) 52 | (let [r (nth s s-pos)] 53 | (update! s-pos inc) 54 | r))) 55 | (peek-char [reader] 56 | (when (> s-len s-pos) 57 | (nth s s-pos)))) 58 | 59 | (deftype InputStreamReader [^InputStream is ^:unsynchronized-mutable ^"[B" buf] 60 | Reader 61 | (read-char [reader] 62 | (if buf 63 | (let [c (aget buf 0)] 64 | (set! buf nil) 65 | (char c)) 66 | (let [c (.read is)] 67 | (when (>= c 0) 68 | (char c))))) 69 | (peek-char [reader] 70 | (when-not buf 71 | (set! buf (byte-array 1)) 72 | (when (== -1 (.read is buf)) 73 | (set! buf nil))) 74 | (when buf 75 | (char (aget buf 0)))) 76 | Closeable 77 | (close [this] 78 | (.close is))) 79 | 80 | (deftype PushbackReader 81 | [rdr ^"[Ljava.lang.Object;" buf ^long buf-len ^:unsynchronized-mutable ^long buf-pos] 82 | Reader 83 | (read-char [reader] 84 | (char 85 | (if (< buf-pos buf-len) 86 | (let [r (aget buf buf-pos)] 87 | (update! buf-pos inc) 88 | r) 89 | (read-char rdr)))) 90 | (peek-char [reader] 91 | (char 92 | (if (< buf-pos buf-len) 93 | (aget buf buf-pos) 94 | (peek-char rdr)))) 95 | IPushbackReader 96 | (unread [reader ch] 97 | (when ch 98 | (if (zero? buf-pos) (throw (RuntimeException. "Pushback buffer is full"))) 99 | (update! buf-pos dec) 100 | (aset buf buf-pos ch))) 101 | Closeable 102 | (close [this] 103 | (when (instance? Closeable rdr) 104 | (.close ^Closeable rdr)))) 105 | 106 | (defn- normalize-newline [rdr ch] 107 | (if (identical? \return ch) 108 | (let [c (peek-char rdr)] 109 | (when (or (identical? \formfeed c) 110 | (identical? \newline c)) 111 | (read-char rdr)) 112 | \newline) 113 | ch)) 114 | 115 | (deftype IndexingPushbackReader 116 | [rdr ^:unsynchronized-mutable ^long line ^:unsynchronized-mutable ^long column 117 | ^:unsynchronized-mutable line-start? ^:unsynchronized-mutable prev 118 | ^:unsynchronized-mutable ^long prev-column file-name] 119 | Reader 120 | (read-char [reader] 121 | (when-let [ch (read-char rdr)] 122 | (let [ch (normalize-newline rdr ch)] 123 | (set! prev line-start?) 124 | (set! line-start? (newline? ch)) 125 | (when line-start? 126 | (set! prev-column column) 127 | (set! column 0) 128 | (update! line inc)) 129 | (update! column inc) 130 | ch))) 131 | 132 | (peek-char [reader] 133 | (peek-char rdr)) 134 | 135 | IPushbackReader 136 | (unread [reader ch] 137 | (if line-start? 138 | (do (update! line dec) 139 | (set! column prev-column)) 140 | (update! column dec)) 141 | (set! line-start? prev) 142 | (unread rdr ch)) 143 | 144 | IndexingReader 145 | (get-line-number [reader] (int line)) 146 | (get-column-number [reader] (int column)) 147 | (get-file-name [reader] file-name) 148 | 149 | Closeable 150 | (close [this] 151 | (when (instance? Closeable rdr) 152 | (.close ^Closeable rdr)))) 153 | 154 | ;; Java interop 155 | 156 | (extend-type java.io.PushbackReader 157 | Reader 158 | (read-char [rdr] 159 | (let [c (.read ^java.io.PushbackReader rdr)] 160 | (when (>= c 0) 161 | (normalize-newline rdr (char c))))) 162 | 163 | (peek-char [rdr] 164 | (when-let [c (read-char rdr)] 165 | (unread rdr c) 166 | c)) 167 | 168 | IPushbackReader 169 | (unread [rdr c] 170 | (when c 171 | (.unread ^java.io.PushbackReader rdr (int c))))) 172 | 173 | (extend LineNumberingPushbackReader 174 | IndexingReader 175 | {:get-line-number (fn [rdr] (.getLineNumber ^LineNumberingPushbackReader rdr)) 176 | :get-column-number (fn [rdr] 177 | (.getColumnNumber ^LineNumberingPushbackReader rdr)) 178 | :get-file-name (constantly nil)}) 179 | 180 | (defprotocol ReaderCoercer 181 | (to-rdr [rdr])) 182 | 183 | (declare string-reader push-back-reader) 184 | 185 | (extend-protocol ReaderCoercer 186 | Object 187 | (to-rdr [rdr] 188 | (if (satisfies? Reader rdr) 189 | rdr 190 | (throw (IllegalArgumentException. (str "Argument of type: " (class rdr) " cannot be converted to Reader"))))) 191 | aiba.lein_count.clojure_tools.reader.reader_types.Reader 192 | (to-rdr [rdr] rdr) 193 | String 194 | (to-rdr [str] (string-reader str)) 195 | java.io.Reader 196 | (to-rdr [rdr] (java.io.PushbackReader. rdr))) 197 | 198 | (defprotocol PushbackReaderCoercer 199 | (to-pbr [rdr buf-len])) 200 | 201 | (extend-protocol PushbackReaderCoercer 202 | Object 203 | (to-pbr [rdr buf-len] 204 | (if (satisfies? Reader rdr) 205 | (push-back-reader rdr buf-len) 206 | (throw (IllegalArgumentException. (str "Argument of type: " (class rdr) " cannot be converted to IPushbackReader"))))) 207 | aiba.lein_count.clojure_tools.reader.reader_types.Reader 208 | (to-pbr [rdr buf-len] (push-back-reader rdr buf-len)) 209 | aiba.lein_count.clojure_tools.reader.reader_types.PushbackReader 210 | (to-pbr [rdr buf-len] (push-back-reader rdr buf-len)) 211 | String 212 | (to-pbr [str buf-len] (push-back-reader str buf-len)) 213 | java.io.Reader 214 | (to-pbr [rdr buf-len] (java.io.PushbackReader. rdr buf-len))) 215 | 216 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 217 | ;; Source Logging support 218 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 219 | (defn merge-meta 220 | "Returns an object of the same type and value as `obj`, with its 221 | metadata merged over `m`." 222 | [obj m] 223 | (let [orig-meta (meta obj)] 224 | (with-meta obj (merge m (dissoc orig-meta :source))))) 225 | 226 | (defn- peek-source-log 227 | "Returns a string containing the contents of the top most source 228 | logging frame." 229 | [source-log-frames] 230 | (let [current-frame @source-log-frames] 231 | (.substring ^StringBuilder (:buffer current-frame) (:offset current-frame)))) 232 | 233 | (defn- log-source-char 234 | "Logs `char` to all currently active source logging frames." 235 | [source-log-frames char] 236 | (when-let [^StringBuilder buffer (:buffer @source-log-frames)] 237 | (.append buffer char))) 238 | 239 | (defn- drop-last-logged-char 240 | "Removes the last logged character from all currently active source 241 | logging frames. Called when pushing a character back." 242 | [source-log-frames] 243 | (when-let [^StringBuilder buffer (:buffer @source-log-frames)] 244 | (.deleteCharAt buffer (dec (.length buffer))))) 245 | 246 | (deftype SourceLoggingPushbackReader 247 | [rdr ^:unsynchronized-mutable ^long line ^:unsynchronized-mutable ^long column 248 | ^:unsynchronized-mutable line-start? ^:unsynchronized-mutable prev 249 | ^:unsynchronized-mutable ^long prev-column file-name source-log-frames] 250 | Reader 251 | (read-char [reader] 252 | (when-let [ch (read-char rdr)] 253 | (let [ch (normalize-newline rdr ch)] 254 | (set! prev line-start?) 255 | (set! line-start? (newline? ch)) 256 | (when line-start? 257 | (set! prev-column column) 258 | (set! column 0) 259 | (update! line inc)) 260 | (update! column inc) 261 | (log-source-char source-log-frames ch) 262 | ch))) 263 | 264 | (peek-char [reader] 265 | (peek-char rdr)) 266 | 267 | IPushbackReader 268 | (unread [reader ch] 269 | (if line-start? 270 | (do (update! line dec) 271 | (set! column prev-column)) 272 | (update! column dec)) 273 | (set! line-start? prev) 274 | (when ch 275 | (drop-last-logged-char source-log-frames)) 276 | (unread rdr ch)) 277 | 278 | IndexingReader 279 | (get-line-number [reader] (int line)) 280 | (get-column-number [reader] (int column)) 281 | (get-file-name [reader] file-name) 282 | 283 | Closeable 284 | (close [this] 285 | (when (instance? Closeable rdr) 286 | (.close ^Closeable rdr)))) 287 | 288 | (defn log-source* 289 | [reader f] 290 | (let [frame (.source-log-frames ^SourceLoggingPushbackReader reader) 291 | ^StringBuilder buffer (:buffer @frame) 292 | new-frame (assoc-in @frame [:offset] (.length buffer))] 293 | (with-bindings {frame new-frame} 294 | (let [ret (f)] 295 | (if (instance? clojure.lang.IMeta ret) 296 | (merge-meta ret {:source (peek-source-log frame)}) 297 | ret))))) 298 | 299 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 300 | ;; Public API 301 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 302 | 303 | ;; fast check for provided implementations 304 | (defn indexing-reader? 305 | "Returns true if the reader satisfies IndexingReader" 306 | [rdr] 307 | (or (instance? aiba.lein_count.clojure_tools.reader.reader_types.IndexingReader rdr) 308 | (instance? LineNumberingPushbackReader rdr) 309 | (and (not (instance? aiba.lein_count.clojure_tools.reader.reader_types.PushbackReader rdr)) 310 | (not (instance? aiba.lein_count.clojure_tools.reader.reader_types.StringReader rdr)) 311 | (not (instance? aiba.lein_count.clojure_tools.reader.reader_types.InputStreamReader rdr)) 312 | (get (:impls IndexingReader) (class rdr))))) 313 | 314 | (defn string-reader 315 | "Creates a StringReader from a given string" 316 | ([^String s] 317 | (StringReader. s (count s) 0))) 318 | 319 | (defn ^Closeable push-back-reader 320 | "Creates a PushbackReader from a given reader or string" 321 | ([rdr] (push-back-reader rdr 1)) 322 | ([rdr buf-len] (PushbackReader. (to-rdr rdr) (object-array buf-len) buf-len buf-len))) 323 | 324 | (defn ^Closeable string-push-back-reader 325 | "Creates a PushbackReader from a given string" 326 | ([s] 327 | (string-push-back-reader s 1)) 328 | ([^String s buf-len] 329 | (push-back-reader (string-reader s) buf-len))) 330 | 331 | (defn ^Closeable input-stream-reader 332 | "Creates an InputStreamReader from an InputStream" 333 | [is] 334 | (InputStreamReader. is nil)) 335 | 336 | (defn ^Closeable input-stream-push-back-reader 337 | "Creates a PushbackReader from a given InputStream" 338 | ([is] 339 | (input-stream-push-back-reader is 1)) 340 | ([^InputStream is buf-len] 341 | (push-back-reader (input-stream-reader is) buf-len))) 342 | 343 | (defn ^Closeable indexing-push-back-reader 344 | "Creates an IndexingPushbackReader from a given string or PushbackReader" 345 | ([s-or-rdr] 346 | (indexing-push-back-reader s-or-rdr 1)) 347 | ([s-or-rdr buf-len] 348 | (indexing-push-back-reader s-or-rdr buf-len nil)) 349 | ([s-or-rdr buf-len file-name] 350 | (IndexingPushbackReader. 351 | (to-pbr s-or-rdr buf-len) 1 1 true nil 0 file-name))) 352 | 353 | (defn ^Closeable source-logging-push-back-reader 354 | "Creates a SourceLoggingPushbackReader from a given string or PushbackReader" 355 | ([s-or-rdr] 356 | (source-logging-push-back-reader s-or-rdr 1)) 357 | ([s-or-rdr buf-len] 358 | (source-logging-push-back-reader s-or-rdr buf-len nil)) 359 | ([s-or-rdr buf-len file-name] 360 | (SourceLoggingPushbackReader. 361 | (to-pbr s-or-rdr buf-len) 362 | 1 363 | 1 364 | true 365 | nil 366 | 0 367 | file-name 368 | (doto (make-var) 369 | (alter-var-root (constantly {:buffer (StringBuilder.) 370 | :offset 0})))))) 371 | 372 | (defn read-line 373 | "Reads a line from the reader or from *in* if no reader is specified" 374 | ([] (read-line *in*)) 375 | ([rdr] 376 | (if (or (instance? LineNumberingPushbackReader rdr) 377 | (instance? BufferedReader rdr)) 378 | (binding [*in* rdr] 379 | (clojure.core/read-line)) 380 | (loop [c (read-char rdr) s (StringBuilder.)] 381 | (if (newline? c) 382 | (str s) 383 | (recur (read-char rdr) (.append s c))))))) 384 | 385 | (defn reader-error 386 | "Throws an ExceptionInfo with the given message. 387 | If rdr is an IndexingReader, additional information about column and line number is provided" 388 | [rdr & msg] 389 | (throw (ex-info (apply str msg) 390 | (merge {:type :reader-exception} 391 | (when (indexing-reader? rdr) 392 | (merge 393 | {:line (get-line-number rdr) 394 | :column (get-column-number rdr)} 395 | (when-let [file-name (get-file-name rdr)] 396 | {:file file-name}))))))) 397 | 398 | (defn source-logging-reader? 399 | [rdr] 400 | (instance? SourceLoggingPushbackReader rdr)) 401 | 402 | (defmacro log-source 403 | "If reader is a SourceLoggingPushbackReader, execute body in a source 404 | logging context. Otherwise, execute body, returning the result." 405 | [reader & body] 406 | `(if (and (source-logging-reader? ~reader) 407 | (not (whitespace? (peek-char ~reader)))) 408 | (log-source* ~reader (^:once fn* [] ~@body)) 409 | (do ~@body))) 410 | 411 | (defn line-start? 412 | "Returns true if rdr is an IndexingReader and the current char starts a new line" 413 | [rdr] 414 | (when (indexing-reader? rdr) 415 | (== 1 (int (get-column-number rdr))))) 416 | -------------------------------------------------------------------------------- /src/aiba/lein_count/core.clj: -------------------------------------------------------------------------------- 1 | (ns aiba.lein-count.core 2 | (:require [aiba.lein-count.clojure-tools.reader :as reader] 3 | [aiba.lein-count.utils :refer [distinct-by-first map-vals relative-path-str]] 4 | [clojure.java.io :as io] 5 | [clojure.string :as string] 6 | [aiba.lein-count.clojure-tools.reader.reader-types :as rt] 7 | [clojure.walk :as walk] 8 | [doric.core :as doric]) 9 | (:import clojure.lang.ExceptionInfo 10 | java.util.jar.JarFile)) 11 | 12 | ;; Analyzing code —————————————————————————————————————————————————————————————————— 13 | 14 | (defn count-form? [x] 15 | (not (and (list? x) 16 | (= (first x) 'comment)))) 17 | 18 | (defn all-meta [form] 19 | (let [data (atom [])] 20 | (walk/prewalk (fn [x] 21 | (when (count-form? x) 22 | (if (reader/constant? x) 23 | (do (swap! data conj {:form (:value x) 24 | :meta (:loc-info x)}) 25 | (:value x)) 26 | (do (swap! data conj {:form x 27 | :meta (meta x)}) 28 | x)))) 29 | form) 30 | @data)) 31 | 32 | (defn read-all-forms [^String s] 33 | (let [rdr (rt/indexing-push-back-reader s) 34 | EOF (Object.) 35 | opts {:eof EOF 36 | :read-cond :allow 37 | :features #{:clj :cljs :cljr}}] 38 | (binding [reader/*alias-map* identity ;; don't need accurate alias resolving 39 | reader/*default-data-reader-fn* (fn [tag x] x) 40 | reader/*wrap-constants* true 41 | reader/*read-eval* :skip] 42 | (loop [ret []] 43 | (let [form (reader/read opts rdr)] 44 | (if (= EOF form) 45 | ret 46 | (recur (conj ret form)))))))) 47 | 48 | (defn file-metrics [data] 49 | (-> (try 50 | (let [m (->> (:content data) (read-all-forms) (mapcat all-meta))] 51 | {:ext (-> (:path data) (string/split #"\.") last) 52 | :nodes (count m) 53 | :lines (->> m 54 | (map :meta) 55 | (mapcat (juxt :line :end-line)) 56 | (remove nil?) 57 | (distinct) 58 | (count))}) 59 | (catch ExceptionInfo e 60 | {:error e})) 61 | (assoc :path (:path data)))) 62 | 63 | (defn source-path? [^String p] 64 | (boolean 65 | (some #(string/ends-with? p %) ["clj" "cljs" "cljc"]))) 66 | 67 | (defn read-files [path] 68 | (let [f (io/file path)] 69 | (assert (.exists f) (str "Doesn't exist: " path)) 70 | (cond 71 | (.isDirectory f) 72 | (->> (file-seq f) 73 | (filter (fn [f] 74 | (and (.isFile f) (source-path? (.getName f))))) 75 | (map (fn [f] 76 | {:path (relative-path-str f) 77 | :content (slurp f)}))) 78 | 79 | (string/ends-with? (.getName f) ".jar") 80 | (let [jf (JarFile. f)] 81 | (->> (.entries jf) 82 | (iterator-seq) 83 | (map (fn [e] 84 | (let [path (.getName e)] 85 | (when (and (not (.isDirectory e)) 86 | (source-path? path) 87 | (not (string/starts-with? path "META-INF/")) 88 | (not (= path "project.clj"))) 89 | {:path path 90 | :content (slurp (.getInputStream jf e))})))) 91 | (remove nil?))) 92 | 93 | ;; This file was specifically asked for so read it regardless of extension 94 | :else 95 | [{:path (relative-path-str f) 96 | :content (slurp f)}]))) 97 | 98 | ;; each path is a string pointing to either a file, a dir, or a jar 99 | (defn metrics [paths] 100 | (->> paths 101 | (mapcat read-files) 102 | (distinct-by-first :path) 103 | (map file-metrics))) 104 | 105 | ;; Generating ASCII report ————————————————————————————————————————————————————————— 106 | 107 | (def columns [{:name :ext :align :left} 108 | {:name :path :align :left :title "File"} 109 | {:name :files :align :right} 110 | {:name :lines :align :right :title "Lines of Code"} 111 | {:name :nodes :align :right}]) 112 | 113 | (defn ascii-table [rows] 114 | (let [ks (-> rows first keys set)] 115 | (doric/table (filter #(contains? ks (:name %)) columns) 116 | rows))) 117 | 118 | (defn dash-row [rows] 119 | (reduce (fn [ret k] 120 | (let [col (->> columns (filter #(= (:name %) k)) first)] 121 | (assoc ret k (apply str 122 | (repeat (->> rows 123 | (map #(count (str (get % k)))) 124 | (apply max 125 | 4 126 | (count (name (:name col))) 127 | (count (get col :title "")))) 128 | "_"))))) 129 | {} 130 | (keys (first rows)))) 131 | 132 | (defn table-by-ext [fms] 133 | (let [by-ext (->> fms 134 | (group-by :ext) 135 | (map-vals (fn [ms] 136 | (as-> ms $ 137 | (map #(dissoc % :ext :path) $) 138 | (apply merge-with + $) 139 | (assoc $ :files (count ms))))) 140 | (seq) 141 | (map #(assoc (val %) :ext (key %)))) 142 | totals (assoc (->> by-ext (map #(dissoc % :ext)) (apply merge-with +)) 143 | :ext "SUM:")] 144 | (ascii-table (concat (sort-by #(get % :lines -1) > by-ext) 145 | [(dash-row by-ext)] 146 | [totals])))) 147 | 148 | (defn table-by-file [fms] 149 | (let [totals (assoc (->> fms (map #(dissoc % :ext :path)) (apply merge-with +)) 150 | :path "SUM:")] 151 | (ascii-table (concat (sort-by #(get % :lines -1) > fms) 152 | [(dash-row fms)] 153 | [totals])))) 154 | 155 | (defn print-report [ms & [opts]] 156 | (let [info (get opts :info println) 157 | warn (get opts :warn println) 158 | errs (->> ms 159 | (filter :error) 160 | (map (fn [x] (merge (ex-data (:error x)) 161 | x 162 | {:error (.getMessage (:error x))})))) 163 | fms (remove :error ms)] 164 | (info "Found" (count ms) "source files.") 165 | (when (seq errs) 166 | (warn "Encountered" (count errs) "reader errors:") 167 | (doseq [e errs] 168 | (warn (pr-str e)))) 169 | (when (seq fms) 170 | (info "") 171 | (info (if (:by-file opts) 172 | (table-by-file fms) 173 | (table-by-ext fms)))))) 174 | 175 | ;; Testing ————————————————————————————————————————————————————————————————————————— 176 | 177 | (comment 178 | 179 | (print-report (metrics ["/Users/aiba/git"])) 180 | 181 | (print-report (metrics ["/Users/aiba/oss/clojurescript/src/main"])) 182 | (print-report (metrics ["/Users/aiba/oss/clojure"])) 183 | 184 | (print-report (metrics ["/Users/aiba/oss"])) 185 | 186 | (print-report (metrics ["./src" "./test-data"]) 187 | {:by-file true}) 188 | 189 | (print-report (metrics ["./src" "./test-data"])) 190 | 191 | (= (metrics ["/tmp/re-frame-realword-example-app/src"]) 192 | (metrics (repeat 4 "/tmp/re-frame-realword-example-app/src"))) 193 | 194 | (metrics ["./test-data/fn_doc.clj"]) 195 | 196 | (->> ["./test-data/fn_doc.clj"] 197 | (mapcat read-files) 198 | first 199 | :content 200 | (read-all-forms) 201 | (mapcat all-meta) 202 | ) 203 | 204 | (metrics ["./test-data/test1.clj"]) 205 | ) 206 | -------------------------------------------------------------------------------- /src/aiba/lein_count/utils.clj: -------------------------------------------------------------------------------- 1 | (ns aiba.lein-count.utils 2 | (:require [clojure.string :as string]) 3 | (:import java.io.File)) 4 | 5 | (defn map-vals [f m] 6 | (reduce-kv (fn [r k v] (assoc r k (f v))) {} m)) 7 | 8 | (defn relative-path-str [^File f] 9 | (let [wd (let [x (System/getProperty "user.dir")] 10 | (if (string/ends-with? x File/separator) 11 | x 12 | (str x File/separator))) 13 | wd-prefix (re-pattern (str "^" (string/re-quote-replacement wd)))] 14 | (-> (.getAbsolutePath f) 15 | (string/replace wd-prefix "")))) 16 | 17 | (defn distinct-by-first 18 | ([f] 19 | (fn [rf] 20 | (let [seen (volatile! #{})] 21 | (fn 22 | ([] (rf)) 23 | ([result] (rf result)) 24 | ([result input] 25 | (let [k (f input)] 26 | (if (contains? @seen k) 27 | result 28 | (do (vswap! seen conj k) 29 | (rf result input))))))))) 30 | ([f coll] 31 | (sequence (distinct-by-first f) coll))) 32 | -------------------------------------------------------------------------------- /src/leiningen/count.clj: -------------------------------------------------------------------------------- 1 | (ns leiningen.count 2 | (:refer-clojure :exclude [count]) 3 | (:require [aiba.lein-count.core :as lc] 4 | [aiba.lein-count.utils :refer [distinct-by-first relative-path-str]] 5 | [clojure.java.io :as io] 6 | [clojure.string :as string] 7 | [leiningen.core.classpath :as lcp] 8 | [leiningen.core.main :refer [info warn]]) 9 | (:import clojure.lang.ExceptionInfo)) 10 | 11 | (defn ^:private all-source-paths [project] 12 | (when project 13 | (concat (:source-paths project) 14 | (when-let [cljsbuild (:cljsbuild project)] 15 | (mapcat :source-paths (:builds cljsbuild)))))) 16 | 17 | (defn path-matches-artifact? [p [artifact version]] 18 | (let [s (let [v (string/split artifact #"\/") 19 | [group id] (case (clojure.core/count v) 20 | 1 [nil (first v)] 21 | 2 v 22 | (throw (ex-info "Malformed artifact" {:artifact artifact})))] 23 | (str "/" 24 | (when group 25 | (str (string/replace group #"\." "/") 26 | "/")) 27 | id "/" version "/" 28 | id "-" version ".jar"))] 29 | (string/ends-with? p s))) 30 | 31 | (defn ^:private artifact-jar [[a b]] 32 | (when (and a b) 33 | (try 34 | (let [project {:repositories [["central" {:url "https://repo1.maven.org/maven2/" 35 | :snapshots false}] 36 | ["clojars" {:url "https://clojars.org/repo/"}]] 37 | :dependencies [[(symbol a) b]]} 38 | jars (lcp/resolve-managed-dependencies 39 | :dependencies :managed-dependencies project)] 40 | (->> jars 41 | (filter #(path-matches-artifact? % [a b])) 42 | (first))) 43 | (catch ExceptionInfo e 44 | (warn "Exception retreiving artifact" [a b]) 45 | (warn (.getMessage e)))))) 46 | 47 | (defn all-files-or-dirs [project args] 48 | (cond 49 | (empty? args) (all-source-paths project) 50 | (= (first args) ":artifact") (when-let [j (artifact-jar (rest args))] 51 | [j]) 52 | :else args)) 53 | 54 | (defn ^:no-project-needed count 55 | "Count lines of code. 56 | 57 | USAGE: lein count [:by-file] 58 | lein count [:by-file] 59 | lein count [:by-file] :artifact GROUP/ID VERSION" 60 | [project & args] 61 | (let [[by-file args] (if (= (first args) ":by-file") 62 | [true (rest args)] 63 | [false args]) 64 | files-or-dirs (->> (all-files-or-dirs project args) 65 | (distinct-by-first #(.getCanonicalPath (io/file %))) 66 | (filter (fn [f] 67 | (or (.exists (io/file f)) 68 | (do (warn "Skipping non-existent file or directory:" f) 69 | false)))))] 70 | (info "Examining" (pr-str (map #(relative-path-str (io/file %)) 71 | files-or-dirs))) 72 | (lc/print-report (lc/metrics files-or-dirs) 73 | {:info info 74 | :warn warn 75 | :by-file by-file}))) 76 | 77 | (comment 78 | (def p {:source-paths ["./src"]}) 79 | (count p) 80 | 81 | (def p {:source-paths ["./src"] 82 | :cljsbuild {:builds [{:source-paths ["./test-data"]}]}}) 83 | 84 | (count p) 85 | (count p "./src") 86 | (count p ":by-file") 87 | (count p ":by-file" "./src") 88 | (count nil) 89 | (count nil ":by-file") 90 | (count nil "./src") 91 | (count nil ":by-file" "./src") 92 | (count nil ":by-file" "./test-data/malformed.clj") 93 | (count nil "/tmp/doesnt-exist") 94 | (count nil "/tmp/doesnt-exist" "./src") 95 | (count nil "/tmp/doesnt-exist" "./src" "./src" "./src") 96 | (count nil "/tmp/doesnt-exist" "./src" "src" "././src") 97 | ) 98 | 99 | (comment 100 | (count nil ":artifact" "com.gfredericks/vcr-clj" "0.4.14") 101 | (count nil ":by-file" ":artifact" "com.gfredericks/vcr-clj" "0.4.143") 102 | (count nil ":artifact" "org.clojure/core.async" "0.3.442") 103 | (count nil ":artifact" "ring/ring-core" "1.6.0") 104 | (count nil ":artifact" "medley" "1.0.0") 105 | (count nil ":artifact" "lein-count" "1.0.0") 106 | (count nil ":artifact" "lein-count" "1.0.1") 107 | (count nil ":artifact" "lein-count" "1.0.2") 108 | (count nil ":artifact" "lein-count" "1.0.3") 109 | (count nil ":artifact" "lein-count" "1.0.4") 110 | ) 111 | -------------------------------------------------------------------------------- /test-data/aliased_ns_kw.clj: -------------------------------------------------------------------------------- 1 | (ns foo 2 | (:require [foo.bar :as bar])) 3 | 4 | ::bar/baz 5 | 6 | -------------------------------------------------------------------------------- /test-data/constants.clj: -------------------------------------------------------------------------------- 1 | (defn g [x] x) 2 | 3 | [1 4 | 2 5 | "three" 6 | "four" 7 | :five 8 | :six 9 | #"regexp1" 10 | #"regexp2" 11 | ] 12 | 13 | (defn f [x] 14 | #_[1 15 | 2 16 | 3 17 | 4 18 | 5 19 | 6] 20 | ) 21 | 22 | (comment 23 | these dont count 24 | 100 25 | 200 26 | 300 27 | 400) 28 | -------------------------------------------------------------------------------- /test-data/fn_doc.clj: -------------------------------------------------------------------------------- 1 | (ns fn-doc) 2 | 3 | (defn f [x] 4 | "This 5 | is 6 | a 7 | long 8 | mult-line 9 | function 10 | doctstring" 11 | (* x x)) 12 | -------------------------------------------------------------------------------- /test-data/just_a_ns.cljs: -------------------------------------------------------------------------------- 1 | (ns foo.bar 2 | (:require [cljs.spec :as s])) 3 | -------------------------------------------------------------------------------- /test-data/malformed.clj: -------------------------------------------------------------------------------- 1 | (ns foo.malformed) 2 | 3 | #include 4 | 5 | int main (void) 6 | { 7 | int i; 8 | for (i = 1; i <= 100; i++) 9 | { 10 | if (!(i % 15)) 11 | printf ("FizzBuzz"); 12 | else if (!(i % 3)) 13 | printf ("Fizz"); 14 | else if (!(i % 5)) 15 | printf ("Buzz"); 16 | else 17 | printf ("%d", i); 18 | 19 | printf("\n"); 20 | } 21 | return 0; 22 | } 23 | -------------------------------------------------------------------------------- /test-data/tags.clj: -------------------------------------------------------------------------------- 1 | (ns data.tags) 2 | 3 | (def x #js {:a 1 4 | :b 2 5 | :c 3 6 | :d 4}) 7 | 8 | #another-tag [1 9 | 2 10 | 3 11 | 4 12 | 5 13 | (fn [x] 14 | (+ x 15 | 1 16 | :foo 17 | :bar 18 | [:baz] 19 | 3 20 | 4))] 21 | -------------------------------------------------------------------------------- /test-data/test1.clj: -------------------------------------------------------------------------------- 1 | (ns data.test1 2 | (:require [clojure.test :as t])) 3 | 4 | (.getTime #inst "2016-02-12T00:09:13.786-00:00") 5 | -------------------------------------------------------------------------------- /test/aiba/lein_count/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns aiba.lein-count.core-test 2 | (:require [aiba.lein-count.core :as lc] 3 | [clojure.test :as t :refer [deftest testing is]])) 4 | 5 | (defn file-metrics [relpath] 6 | (let [r (lc/metrics [(str "./test-data/" relpath)])] 7 | (is (= (count r) 1)) 8 | (first r))) 9 | 10 | (defmacro def-file-test [file-name expected] 11 | `(deftest ~(symbol file-name) 12 | (let [m# (file-metrics ~file-name)] 13 | (doseq [[k# v#] ~expected] 14 | (testing (str ~file-name "[" (name k#) "]") 15 | (is (= (get m# k#) v#))))))) 16 | 17 | (def file-test-cases 18 | {"aliased_ns_kw.clj" {:lines 3 :nodes 10} 19 | "constants.clj" {:lines 12 :nodes 20} 20 | "fn_doc.clj" {:lines 5 :nodes 13} 21 | "just_a_ns.cljs" {:lines 2 :nodes 9} 22 | "malformed.clj" {:lines nil :nodes nil} 23 | "tags.clj" {:lines 18 :nodes 39} 24 | "test1.clj" {:lines 3 :nodes 12}}) 25 | 26 | (defmacro def-all-file-tests! [] 27 | `(do 28 | ~@(for [[f m] file-test-cases] 29 | `(def-file-test ~f ~m)))) 30 | 31 | (def-all-file-tests!) 32 | --------------------------------------------------------------------------------