/
utils.clj
271 lines (237 loc) · 9.13 KB
/
utils.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
(ns leiningen.core.utils
(:require [clojure.java.io :as io]
[clojure.java.shell :as sh])
(:import (com.hypirion.io RevivableInputStream)
(clojure.lang LineNumberingPushbackReader)
(java.io ByteArrayOutputStream PrintStream File FileDescriptor
FileOutputStream FileInputStream InputStreamReader)
(java.net URL)))
(def rebound-io? (atom false))
(defn rebind-io! []
(when-not @rebound-io?
(let [new-in (-> FileDescriptor/in FileInputStream. RevivableInputStream.)]
(System/setIn new-in)
(.bindRoot #'*in* (-> new-in InputStreamReader.
LineNumberingPushbackReader.)))
(reset! rebound-io? true)))
(defn build-url
"Creates java.net.URL from string"
[url]
(try (URL. url)
(catch java.net.MalformedURLException _
(URL. (str "http://" url)))))
(defmacro with-write-permissions
"Runs body only if path is writeable, or - if it does not already exist - can
be created."
[path & body]
`(let [p# ~path
f# (new File p#)]
(if (or (and (.exists f#) (.canWrite f#))
(and (not (.exists f#)) (some-> f# .getParentFile .canWrite)))
(do ~@body)
(throw (java.io.IOException.
(str "Permission denied. Please check your access rights for " p#))))))
(defn read-file
"Returns the first Clojure form in a file if it exists."
[file]
(if (.exists file)
(try (read-string (slurp file))
(catch Exception e
(binding [*out* *err*] ;; TODO: use main/warn for this in 3.0
(println "Error reading"
(.getName file)
"from"
(.getParent file))
(if (zero? (.length file))
(println "File cannot be empty")
(if (.contains (.getMessage e) "EOF while reading")
(println "Invalid content was found")
(println (.getMessage e)))))))))
(defn symlink?
"Checks if a File is a symbolic link or points to another file."
[file]
(let [canon (if-not (.getParent file)
file
(-> (.. file getParentFile getCanonicalFile)
(File. (.getName file))))]
(not= (.getCanonicalFile canon)
(.getAbsoluteFile canon))))
(defn mkdirs
"Make a given directory and its parents, but throw an Exception on failure."
[f] ; whyyyyy does .mkdirs fail silently ugh
(let [already-exists? (.exists (io/file f))]
(when-not (or (.mkdirs (io/file f)) already-exists?)
(throw (Exception. (str "Couldn't create directories: " (io/file f)))))))
(defn relativize
"Makes the filepath path relative to base. Assumes base is an ancestor to
path, and that the path contains no '..'."
[base path]
;; TODO: When moving to Java 1.7, use Path's relativize instead
(let [base-uri (.toURI (io/file base))
path-uri (.toURI (io/file path))]
(.. base-uri (relativize path-uri) (getPath))))
(defn ns-exists? [namespace]
(or (find-ns (symbol namespace))
(some (fn [suffix]
(-> (#'clojure.core/root-resource namespace)
(subs 1)
(str suffix)
io/resource))
[".clj" ".cljc" (str clojure.lang.RT/LOADER_SUFFIX ".class")])))
(defn error [& args]
(binding [*out* *err*] ;; TODO: use main/warn for this in 3.0
(apply println "Error:" args)))
(defn require-resolve
"Resolve a fully qualified symbol by first requiring its namespace."
([sym]
(if-let [ns (namespace sym)]
(when (ns-exists? ns)
(let [ns (symbol ns)]
(when-not (find-ns ns)
(require ns)))
(resolve sym))
(resolve sym)))
([ns sym] (require-resolve (symbol ns sym))))
;; # OS detection
(defn- get-by-pattern
"Gets a value from map m, but uses the keys as regex patterns, trying
to match against k instead of doing an exact match."
[m k]
(m (first (drop-while #(nil? (re-find (re-pattern %) k))
(keys m)))))
(defn- get-with-pattern-fallback
"Gets a value from map m, but if it doesn't exist, fallback
to use get-by-pattern."
[m k]
(let [exact-match (m k)]
(if (nil? exact-match)
(get-by-pattern m k)
exact-match)))
(def ^:private native-names
{"Mac OS X" :macosx "Windows" :windows "Linux" :linux
"FreeBSD" :freebsd "OpenBSD" :openbsd
"amd64" :x86_64 "x86_64" :x86_64 "x86" :x86 "i386" :x86
"arm" :arm "SunOS" :solaris "sparc" :sparc "Darwin" :macosx})
(defn get-os
"Returns a keyword naming the host OS."
[]
(get-with-pattern-fallback native-names (System/getProperty "os.name")))
(defn get-arch
"Returns a keyword naming the host architecture"
[]
(get-with-pattern-fallback native-names (System/getProperty "os.arch")))
(defn platform-nullsink
"Returns a file destination that will discard output."
[]
(io/file (if (= :windows (get-os))
"NUL"
"/dev/null")))
;; The ordering on map-vals and filter-vals may seem strange, but it helps out
;; if you want to do stuff like (update m :foo map-vals f extra-args)
(defn map-vals
"Like 'update', but for all values in a map."
[m f & args]
(zipmap (keys m) (map #(apply f % args) (vals m))))
(defn filter-vals
"Like filter, but for values over a map: If pred is satisfied on a value in m,
then its entry is preserved, otherwise it is removed."
[m pred]
(->> (filter #(pred (val %)) m)
(into {})))
;; # Git
;; This is very similar to the read-file function above. The only differences
;; are the error messages and the transformations done on the content.
(defn- git-file-contents
"Returns the (trimmed) contents by the given git path, or nil if it is
inacessible or nonexisting. If it exists and is not readable, a warning is
printed."
[git-dir ref-path]
(let [ref (io/file git-dir ref-path)]
(if (.canRead ref)
(.trim (slurp ref))
(do
(when (.exists ref)
(binding [*out* *err*] ;; TODO: use main/warn for this in 3.0
(println "Warning: Contents of git file"
(str ".git/" ref-path) "is not readable.")
(println "(Check that you have the right permissions to read"
"the .git repo)")))
nil))))
(defn ^:internal resolve-git-dir [project]
(let [alternate-git-root (io/file (get-in project [:scm :dir]))
git-dir-file (io/file (or alternate-git-root (:root project)) ".git")]
(if (and (.isFile git-dir-file) (.canRead git-dir-file))
(io/file (second (re-find #"gitdir: (\S+)" (slurp (str git-dir-file)))))
git-dir-file)))
(defn- read-git-ref
"Reads the commit SHA1 for a git ref path, or nil if no commit exist."
[git-dir ref-path]
(git-file-contents git-dir ref-path))
(defn- read-git-head-file
"Reads the current value of HEAD by attempting to read .git/HEAD, returning
the SHA1 or nil if none exists."
[git-dir]
(some->> (git-file-contents git-dir "HEAD")
(re-find #"ref: (\S+)")
(second)
(read-git-ref git-dir)))
;; TODO: de-dupe with pom namespace (3.0?)
(defn ^:internal read-git-head
"Reads the value of HEAD and returns a commit SHA1, or nil if no commit
exist."
[git-dir]
(try
(let [git-ref (sh/sh "git" "rev-parse" "HEAD" :dir git-dir)]
(if (= (:exit git-ref) 0)
(.trim (:out git-ref))
(read-git-head-file git-dir)))
(catch java.io.IOException e (read-git-head-file git-dir))))
(defn last-distinct
"Like distinct, but retains the last version instead of the first version of a
duplicate."
[coll]
(reverse (distinct (reverse coll))))
;; Inspired by distinct-by from medley (https://github.com/weavejester/medley),
;; also under the EPL 1.0.
(defn last-distinct-by
"Returns a lazy sequence of the elements of coll, removing any
elements that return duplicate values when passed to a function f.
Only the last element that is a duplicate is preserved."
[f coll]
(let [step (fn step [xs seen]
(lazy-seq
((fn [[x :as xs] seen]
(when-let [s (seq xs)]
(let [fx (f x)]
(if (contains? seen fx)
(recur (rest s) seen)
(cons x (step (rest s) (conj seen fx)))))))
xs seen)))]
(reverse (step (reverse coll) #{}))))
(defn ancestor?
"Is a an ancestor of b?"
[a b]
(let [hypothetical-ancestor (.getCanonicalPath (io/file a))
hypothetical-descendant (.getCanonicalPath (io/file b))]
(and (.startsWith hypothetical-descendant hypothetical-ancestor)
(not (= hypothetical-descendant hypothetical-ancestor)))))
(defmacro with-system-out-str
"Like with-out-str, but for System/out."
[& body]
`(try (let [o# (ByteArrayOutputStream.)]
(System/setOut (PrintStream. o#))
~@body
(.toString o#))
(finally
(System/setOut
(-> FileDescriptor/out FileOutputStream. PrintStream.)))))
(defmacro with-system-err-str
"Like with-out-str, but for System/err."
[& body]
`(try (let [o# (ByteArrayOutputStream.)]
(System/setErr (PrintStream. o#))
~@body
(.toString o#))
(finally
(System/setErr
(-> FileDescriptor/err FileOutputStream. PrintStream.)))))