-
Notifications
You must be signed in to change notification settings - Fork 7
/
utils.clj
223 lines (177 loc) · 6.5 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
(ns pronto.utils
(:require [clojure.string :as s]
[pronto.protos :refer [global-ns]])
(:import
[pronto ProtoMap]
[com.google.protobuf
Descriptors$FieldDescriptor
Descriptors$GenericDescriptor
Descriptors$FieldDescriptor$Type
GeneratedMessageV3]))
(defn javaify [s] (s/replace s "-" "_"))
(defn normalize-path [s]
(-> s
(s/replace "." "_")
(s/replace "$" "__")))
(defn sanitized-class-name [^Class clazz]
(normalize-path (.getName clazz)))
(defn class->map-class-name [^Class clazz]
(symbol (str (sanitized-class-name clazz) "ProtoMap")))
(defn class->abstract-map-class-name [^Class clazz]
(symbol (str (sanitized-class-name clazz) "AbstractMap")))
(defn class->abstract-persistent-map-class-name [^Class clazz]
(symbol (str (sanitized-class-name clazz) "AbstractPersistentMap")))
(defn class->transient-class-name [^Class clazz]
(symbol (str 'transient_ (sanitized-class-name clazz))))
(defn ->kebab-case
"Converts `s`, assumed to be in snake_case, to kebab-case"
[^String s]
(when s
(s/lower-case (.replace s \_ \-))))
(defn with-type-hint [sym ^Class clazz]
(with-meta sym {:tag (symbol (.getName clazz))}))
(defn ctor-name [prefix ^Class clazz]
(symbol (str prefix '-> (class->map-class-name clazz))))
(defn ->camel-case
"Implements protobuf's camel case conversion for Java. See: https://github.com/protocolbuffers/protobuf/blob/v3.12.4/src/google/protobuf/compiler/java/java_helpers.cc#L157"
[^String s]
(when-let [length (some-> s .length)]
(loop [i 0
^StringBuilder sb (StringBuilder.)
cap-next-letter? true]
(if (= i length)
(.toString sb)
(let [x (.charAt s i)]
(cond
(Character/isLowerCase x)
(recur (inc i)
(.append sb (if cap-next-letter? (Character/toUpperCase x) x))
false)
(Character/isUpperCase x)
(recur (inc i) (.append sb x) false)
(Character/isDigit x)
(recur (inc i) (.append sb x) true)
:else
(recur (inc i) sb true)))))))
(defn field->camel-case [^Descriptors$GenericDescriptor field]
(->camel-case (.getName field)))
(defn field->kebab-case [^Descriptors$GenericDescriptor field]
(->kebab-case (.getName field)))
(defn message? [^Descriptors$FieldDescriptor fd]
(= (.getType fd)
Descriptors$FieldDescriptor$Type/MESSAGE))
(defn struct? [^Descriptors$FieldDescriptor fd]
(and (message? fd)
(not (.isMapField fd))
(not (.isRepeated fd))))
(defn enum? [^Descriptors$FieldDescriptor fd]
(= (.getType fd)
Descriptors$FieldDescriptor$Type/ENUM))
(defn static-call [^Class class method-name]
(symbol (str (.getName class) "/" method-name)))
(defn type-error-info [clazz field-name expected-type value]
{:class clazz
:field field-name
:expected-type expected-type
:value value})
(defn make-type-error
([clazz field-name expected-type value]
(make-type-error clazz field-name expected-type value nil))
([clazz field-name expected-type value cause]
;; return as code so this frame isn't included in the stack trace
`(ex-info "Invalid type" ~(type-error-info clazz field-name expected-type value) ~cause)))
(defmacro with-ns [new-ns & body]
(let [orig-ns *ns*
orig-ns-name (ns-name orig-ns)
ns-name-sym (symbol new-ns)
existing-classes (set (when-let [n (find-ns ns-name-sym)]
(vals (ns-imports n))))]
(if (or (nil? new-ns)
(= new-ns (str *ns*)))
body
`(do
(create-ns (quote ~ns-name-sym))
(in-ns (quote ~ns-name-sym))
~@(for [[_ ^Class clazz]
(ns-imports orig-ns)
:let [class-name (.getName clazz)]
:when (not (get existing-classes clazz))
;; No point to import POJO classes, and this can also
;; lead to conflicts if 2 namespaces import 2 classes
;; with the same name but different packages.
:when (not= (.getSuperclass clazz) GeneratedMessageV3)
;; don't import generated classes created by the lib, as this might
;; lead to collision between different mappers when importing
;; these classes into the global ns
:when (not (s/starts-with? class-name (javaify global-ns)))]
`(import ~(symbol (.getName clazz))))
;; clojure.core is not auto-loaded so load it explicitly
;; in order for any of its vars to be resolvable
(use '[clojure.core])
~@body
#_(finally)
(in-ns (quote ~(symbol orig-ns-name)))))))
(defn- split' [f coll]
(loop [[x & xs :as c] coll
res []]
(if-not x
res
(if (f x)
(recur
xs
(conj res x))
(let [[a b] (split-with (complement f) c)]
(recur
b
(conj res a)))))))
(def leaf-val :val)
(defn leaf [x] (with-meta {:val x} {::leaf? true}))
(def leaf? (comp boolean ::leaf? meta))
(defn kv-forest [kvs]
(loop [[kv-partition & ps] (partition-by ffirst kvs)
res []]
(if-not kv-partition
res
(let [leader-key (first (ffirst kv-partition))
follower-kvs (->> kv-partition
(map
(fn [[ks v]]
(let [rks (rest ks)]
(if (seq rks)
(vector rks v)
(leaf v)))))
(split' leaf?))]
(recur
ps
(conj
res
[leader-key
(mapcat
(fn [g]
(if (leaf? g)
[g]
(kv-forest g)))
follower-kvs)]))))))
(defn- flatten-forest* [forest]
(if-not (seq forest)
[]
(for [[k tree] forest
v tree]
(if (leaf? v)
[[k] (leaf-val v)]
(mapcat
(fn [[k' v']]
[(cons k k') v'])
(flatten-forest* [v]))))))
(defn flatten-forest [forest]
(partition 2 (apply concat (flatten-forest* forest))))
(defn safe-resolve [x]
(try
(resolve x)
(catch Exception _)))
(defn proto-map? [m]
(instance? ProtoMap m))
(defn proto-map->proto
"Returns the protobuf instance associated with the proto-map"
[^ProtoMap m]
(.pmap_getProto m))