/
data_xml.clj
244 lines (213 loc) · 8.64 KB
/
data_xml.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
(ns lambdaconnect-model.data-xml
(:require [clojure.xml]
[clojure.algo.generic.functor :refer [fmap]]
[clojure.spec.gen.alpha :as gen]
[clojure.spec.alpha :as s]
[lambdaconnect-model.tools :as t]
[lambdaconnect-model.data-xml :as xml]))
(defn regex? [r] (instance? java.util.regex.Pattern r))
(s/def :types/regex
(s/with-gen regex?
(fn [] (gen/fmap re-pattern (s/gen string?)))))
(def types-map {"String" :db.type/string
"Date" :db.type/instant
"Boolean" :db.type/boolean
"Integer 32" :db.type/long
"Integer 64" :db.type/long
"Integer 16" :db.type/long
"Float" :db.type/float
"Double" :db.type/double
"Binary" :db.type/bytes
"UUID" :db.type/uuid
"URI" :db.type/string})
(def basic-validators {:db.type/string string?
:db.type/instant inst?
:db.type/boolean boolean?
:db.type/long int?
:db.type/uuid uuid?
:db.type/double double?
:db.type/float float?
:db.type/bytes bytes?})
(s/def ::name string?)
(s/def ::entity-name string?)
(s/def ::type (set (vals types-map)))
(s/def ::default-value (s/nilable
(apply (t/functionise s/or)
(t/mapcat identity basic-validators))))
(s/def ::regular-expression (s/nilable :types/regex))
(s/def ::max-value (s/nilable (s/or :db.type/long int? :db.type/instant inst?)))
(s/def ::min-value (s/nilable (s/or :db.type/long int? :db.type/instant inst?)))
(s/def ::optional boolean?)
(s/def ::indexed boolean?)
(s/def ::user-info (s/nilable (s/map-of string? string?)))
(s/def ::attribute (s/keys
:req-un
[::name
::type
::optional
::indexed
::entity-name
::user-info]
:opt-un
[::default-value
::regular-expression
::max-value
::min-value]))
(defrecord Attribute [name
entity-name
type
optional
indexed
default-value
regular-expression
max-value
min-value
user-info])
(s/def ::to-many boolean?)
(s/def ::destination-entity string?)
(s/def ::inverse-name string?)
(s/def ::inverse-entity string?)
(s/def ::max-count (s/nilable int?))
(s/def ::relationship (s/keys
:req-un
[::name
::entity-name
::optional
::to-many
::destination-entity
::inverse-name
::inverse-entity
::user-info]
:opt-un [::max-count]))
(defrecord Relationship [name
entity-name
optional
to-many
destination-entity
inverse-name
inverse-entity
max-count
user-info])
(s/def ::attributes (s/map-of string? ::attribute))
(s/def ::relationships (s/map-of string? ::relationship))
(s/def ::datomic-relationships (s/nilable (s/map-of string? ::relationship)))
(s/def ::entity (s/keys :req-un [::name
::attributes
::relationships
::user-info]
:opt-un [::datomic-relationships]))
; Datomic-relationships is a filtered version of relationships, holding the relationship object.
; It arbitrarily (but stably) defines, for every pair ( (entity1, relationship), (entity2, inverse) ) which relationship should be modeled
; in the db as modelling it both ways is inefficient, prone to errors and against the spirit of datomic.
; The selection logic is encoded in tools/relevant-relationship-from-pair
(defrecord Entity [name
attributes
relationships
datomic-relationships
user-info])
; ------------ PARSING ------------
(defn ->bool [val] (= val "YES"))
(defn ->date
"Apple uses seconds since 1.1.2001, we have to add the epoch timestamp of this date"
[val]
(when val (java.util.Date. (* 1000 (+ 978307200 (Integer. val))))))
(defn ->type [val] (get types-map val))
(defn ->regex [val] (when val (re-pattern val)))
(defn ->dbl [val] (when val (Double. val)))
(defn ->float [val] (when val (Float. val)))
(defn ->int [val] (when val (try (Integer. val) (catch Throwable _ (Math/round (->float val))))))
(defn ->value [val type]
(when val
(case type
:db.type/string val
:db.type/boolean (->bool val)
:db.type/long (->int val)
:db.type/double (->dbl val)
:db.type/instant (->date val)
:db.type/float (->float val))))
(defn ->sync-revision [entity-name]
(->Attribute
"syncRevision"
entity-name
:db.type/long
true
false
nil
nil
nil
nil
nil))
(defn attribute-from-xml [entity-name xml user-info]
(let [type (->type (:attributeType xml))]
(->Attribute
(:name xml)
entity-name
type
(->bool (:optional xml))
(->bool (:indexed xml))
(->value (or (:defaultValueString xml) (:defaultDateTimeInterval xml)) type)
(->regex (:regularExpressionString xml))
(or (->int (:maxValueString xml)) (->date (:maxDateTimeInterval xml)))
(or (->int (:minValueString xml)) (->date (:minDateTimeInterval xml)))
user-info)))
(s/fdef attribute-from-xml :ret ::attribute)
(defn relationship-from-xml [entity-name xml user-info]
(->Relationship
(:name xml)
entity-name
(->bool (:optional xml))
(->bool (:toMany xml))
(:destinationEntity xml)
(:inverseName xml)
(:inverseEntity xml)
(->int (:maxCount xml))
user-info))
(s/fdef relationship-from-xml :ret ::relationship)
(defn user-info-from-xml [xml]
(->> xml
(filter #(= :userInfo (:tag %)))
(mapcat #(->> % :content (map (comp (juxt :key :value) :attrs))))
(into {})))
(s/fdef user-info-from-xml :ret ::user-info)
(defn entity-from-xml
"Parses an entity from its pre-parsed xml tree"
[xml]
(assert (= :entity (:tag xml)))
(let [name (-> xml :attrs :name)
parse-elements (fn [f type]
(fmap first
(group-by :name
(map
(comp (partial apply f name)
(juxt :attrs (comp user-info-from-xml :content)))
(filter #(and (= type (:tag %))
(not (:transient %)))
(:content xml))))))]
(->Entity
name
(-> attribute-from-xml
(parse-elements :attribute)
(assoc "syncRevision" (->sync-revision name))
(dissoc "isSuitableForPush"))
(parse-elements relationship-from-xml :relationship)
nil ; no datomic relationships at this stage
(-> xml :content user-info-from-xml))))
(s/fdef entity-from-xml :ret ::entity)
; ------------- READING --------------
(defn entities-by-name [xml]
(let [results (->> xml
(.getBytes)
(java.io.ByteArrayInputStream.)
clojure.xml/parse
:content
(filter #(= :entity (:tag %)))
(map entity-from-xml))
pre-datomic (fmap first (group-by :name results))]
(assert (reduce #(and %1 %2) (map (partial s/valid? ::entity) results)) (reduce str (map (partial s/explain-str ::entity) results)))
(let [pairs (t/relationship-pairs pre-datomic)
relevant-relationships (t/mapcat t/relevant-relationship-from-pair pairs)
relevant-relationships-by-entity (group-by :entity-name relevant-relationships)
full-entities (map #(assoc % :datomic-relationships
(fmap first (group-by :name (get relevant-relationships-by-entity (:name %))))) results)]
(assert (reduce #(and %1 %2) (map (partial s/valid? ::entity) full-entities)) (reduce str (map (partial s/explain-str ::entity) full-entities)))
(fmap first (group-by :name full-entities)))))