-
Notifications
You must be signed in to change notification settings - Fork 9
/
collections.clj
158 lines (140 loc) · 5.57 KB
/
collections.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
(ns cider.enrich-classpath.collections
(:require
[cider.enrich-classpath.logging :refer [warn]]
[clojure.pprint :as pprint]
[clojure.walk :as walk]))
(defn index [coll item]
{:pre [(vector? coll)]
:post [(or (-> % long pos?) ;; note: there's no nat-int? in old versions of Lein
(-> % long zero?))]}
(first (into (empty coll)
(comp (map-indexed (fn [i x]
(when (= x item)
i)))
(filter some?))
coll)))
(defn normalize-exclusions [exclusions]
(assert (or (sequential? exclusions)
;; very unusual edge case:
(set? exclusions))
(pr-str exclusions))
(->> exclusions
(mapv (fn [x]
(cond-> x
(not (vector? x)) vector)))))
(defn maybe-normalize* [x]
(with-meta (->> x
(walk/postwalk (fn [item]
(cond-> item
(and (vector? item)
(some #{'exclusions} item))
(update (long (index item 'exclusions))
keyword)
(and (vector? item)
(some #{:exclusions 'exclusions} item))
(update (inc (long (or (index item :exclusions)
(index item 'exclusions))))
normalize-exclusions)))))
(let [{:keys [file]} (meta x)]
(when file
{:file (str file)}))))
(def maybe-normalize (memoize maybe-normalize*))
(defn ppr-str [x]
(with-out-str
(pprint/pprint x)))
(defn debugging-compare [x y]
(try
(compare x y)
(catch Exception e
(warn (ppr-str [::could-not-compare x y]))
(throw e))))
(defn safe-sort
"Guards against errors when comparing objects of different classes."
[coll]
(try
(->> coll
(sort (fn inner-compare [x y]
(try
(cond
(and (vector? x) (not (coll? y)))
(inner-compare x [y])
(and (vector? y) (not (coll? x)))
(inner-compare [x] y)
true
(->> [x y]
(map maybe-normalize)
(apply debugging-compare)))
(catch Exception e
(warn (ppr-str [::could-not-sort x y]))
(when (System/getProperty "cider.enrich-classpath.throw")
(throw e))
0)))))
(catch Exception e
(warn (ppr-str [::could-not-sort coll]))
(when (System/getProperty "cider.enrich-classpath.throw")
(throw e))
coll)))
(defn ensure-no-lists* [x]
{:pre [(vector? x)]}
(with-meta (->> x (mapv (fn [y]
(let [v (cond-> y
(sequential? y) vec)]
(cond-> v
(vector? v) ensure-no-lists*)))))
(let [{:keys [file]} (meta x)]
(when file
{:file (str file)}))))
(def ensure-no-lists (memoize ensure-no-lists*))
(defn flatten-deps [xs]
(->> xs
(mapcat (fn [[k v]]
(apply list k v)))))
(defn add-exclusions-if-classified [coordinate]
{:pre [(vector? coordinate)
(not (vector? (first coordinate)))]}
(let [catchall '[[*]]]
(if-not (some #{:classifier} coordinate)
coordinate
(let [maybe-with-catchall-exclusions (cond-> coordinate
(not (some #{:exclusions} coordinate))
(conj :exclusions catchall))]
(->> maybe-with-catchall-exclusions
(reduce (fn [{:keys [found? result]} x]
(if found?
{:found? false
:result (conj result catchall)}
{:found? (= x :exclusions)
:result (conj result x)}))
{:found? false
:result []})
(:result))))))
;; Vendored (and modified) code, for avoiding depending on clojure.spec
;; ...Lein can run old Clojure versions predating Spec.
(defn divide-by
"Divides `coll` in `n` parts. The parts can have disparate sizes if the division isn't exact."
{:author "https://github.com/nedap/utils.collections"
:license "Eclipse Public License 2.0"}
[^long n coll]
(let [the-count (count coll)
seed [(-> the-count double (/ n) Math/floor)
(rem the-count n)
[]
coll]
recipe (iterate (fn [[quotient remainder output input]]
(let [remainder (long remainder)
quotient (long quotient)
chunk-size (+ quotient (if (pos? remainder)
1
0))
addition (take chunk-size input)
result (cond-> output
(seq addition) (conj addition))]
[quotient
(dec remainder)
result
(drop chunk-size input)]))
seed)
index (inc n)]
(-> recipe
(nth index)
(nth 2))))