-
Notifications
You must be signed in to change notification settings - Fork 0
/
tools.clj
146 lines (124 loc) · 5.51 KB
/
tools.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
(ns lambdaconnect-model.tools
(:require [clojure.string :as s]
[clj-time.format :as time-format]
[clj-time.coerce :as c]
[clojure.spec.alpha :as spec]
[clojure.set :refer [difference intersection]]))
; Those fileds are excluded from automatic schema generation as they all have "app" prefix and are common for all the objects
(def special-attribs #{"active" "uuid" "createdAt" "updatedAt" "syncRevision"})
(def special-unmodifiable-attribs (difference special-attribs #{"active"}))
(def fake-attribs #{"syncRevision"})
(def time-formatter (time-format/formatter :date-time)) ; ISO8601
(defmacro functionise [macro]
`(fn [& args#] (eval (cons '~macro args#))))
(defn unique-datomic-identifier [entity]
(keyword (:name entity) "ident__"))
(defn datomic-name
[o]
(let [n (:name o)]
(keyword (if (special-attribs n) "app" (:entity-name o)) n)))
(defn datomic-inverse-name
[rel]
(let [n (:inverse-name rel)]
(keyword (:destination-entity rel) (str "_" n))))
(defn attrib-or-relationship [entities-by-name j]
(let [[e n] (if (keyword? j) [(namespace j) (name j)] (s/split (str j) #"/"))
entity (entities-by-name e)
attr ((:attributes entity) n)
rel ((:relationships entity) n)]
(assert (or attr rel) (str "There is no attribute nor relationship named '" n "' for entity '" e "'"))
(assert (not (and attr rel)) (str "There is a relationship AND an attribute named '" n "' for entity '" e "'"))
(or attr rel)))
(defn mapcat
; We need our own implementation, see http://clojurian.blogspot.com/2012/11/beware-of-mapcat.html
([f coll] (lambdaconnect-model.tools/mapcat f coll (lazy-seq [])))
([f coll acc]
(if (empty? coll) acc
(recur f (rest coll) (lazy-seq (concat acc (f (first coll))))))))
(defn to-database-date [date]
(if (instance? java.util.Date date) date (c/to-date date)))
(defn string->uuid
[s]
(if (uuid? s) s
(do
(assert (string? s) (str "Not a string passed as a UUID: " s))
(. java.util.UUID fromString s))))
; ================================================
; Parsers
(defn parser-for-attribute [attribute]
(if (= (:name attribute) "uuid")
string->uuid
(case (:type attribute)
:db.type/uuid string->uuid
:db.type/instant #(when (not (nil? %)) (->> %
(time-format/parse time-formatter)
(to-database-date)))
:db.type/boolean #(when (not (nil? %)) (if-not (= false %)
(or (= % true) (> % 0))
false))
:db.type/bytes (assert false "Not supported yet")
:db.type/double double
:db.type/float float
identity)))
(defn inverse-parser-for-attribute [attribute]
(if (= (:name attribute) "uuid")
str
(case (:type attribute)
:db.type/instant #(->> %
(c/from-date)
(time-format/unparse time-formatter))
:db.type/uuid str
:db.type/boolean #(if % 1 0)
:db.type/bytes (assert false "Not supported yet")
identity)))
(defn parser-for-relationship [rel]
(if (:to-many rel)
#(map (fn [uuid-string] {:app/uuid (string->uuid uuid-string)}) %)
#(when % {:app/uuid (string->uuid %)})))
(defn inverse-parser-for-relationship [rel]
(if (:to-many rel)
#(map (comp str :app/uuid) %)
#(when % (if (sequential? %) (first (map (comp str :app/uuid) %)) ((comp str :app/uuid) %)))))
(defn relationship-for-inverse-name [entity inverse-name] ; e.g. :FIGame/_organiser
(when (= \_ (first (name inverse-name)))
(let [rels (vals (:relationships entity))
inverse-entity-name (namespace inverse-name)
inverse-rel-name (subs (name inverse-name) 1)]
(first (filter #(and (= (:inverse-entity %) inverse-entity-name)
(= (:inverse-name %) inverse-rel-name)) rels)))))
; ================================================
(defn relationship-pairs
"Generates a set of pairs of relationships"
[e-by-name]
(map #(sort-by :name (vec %))
(mapcat (fn [entity]
(set
(map
(fn [rel]
(let [dest-ent (get e-by-name (:destination-entity rel))]
[rel (get (:relationships dest-ent) (:inverse-name rel))]))
(vals (:relationships entity)))))
(vals e-by-name))))
(defn relevant-relationship-from-pair
"Relationship generation strategy."
[[left right]]
(cond
(and (not (:to-many left)) (not (:to-many right))) [left]
(and (not (:to-many left)) (:to-many right)) [left]
(and (:to-many left) (not (:to-many right))) [right]
(and (:to-many left) (:to-many right)) [left]))
(defn defining-attributes [entities-by-name]
(into {} (map (fn [[name entity]]
[name (unique-datomic-identifier entity)])
(vec entities-by-name))))
(defn compare-objects [o1 o2 entity]
(let [o1-keys (set (keys o1))
o2-keys (set (keys o2))
common-keys (intersection o1-keys o2-keys)
spec (keyword "lambdaconnect-model.spec.json" (:name entity))]
(and
(spec/valid? spec o1)
(spec/valid? spec o2)
(= (select-keys o1 common-keys) (select-keys o2 common-keys))
(reduce #(and %1 %2) true (map #(or (nil? (% o1)) (empty? (% o1))) (difference o1-keys o2-keys)))
(reduce #(and %1 %2) true (map #(or (nil? (% o2)) (empty? (% o2))) (difference o2-keys o1-keys))))))