Initial crux-datoms spike

txfns.clj

  {:crux.db/id :reify-tx
   :crux.db/fn '(fn [ctx ops & [annotation-map]]
                   (conj ops [:crux.tx/put (merge
                                            (or annotation-map {})
                                            {:crux.db/id :tx-meta
                                             :ops ops
                                             :tx-meta/tx-instant (new java.util.Date)
                                             :tx-meta/ids (into #{} (map #(nth % 2) ops))})]))}

   {:crux.db/id :add
    :crux.db/fn '(fn [ctx entity-id & [attribute value]]
                   (let [db (crux.api/db ctx)
                         schema (crux.api/entity db :schema)]
                     (if (or (not= (:crux.db/unique (attribute schema)) :crux.db.unique/identity)
                               (and (= (:crux.db/unique (attribute schema)) :crux.db.unique/identity)
                                    (empty? (crux.api/q db {:find '[e] :where [['e attribute value]]}))))
                       (if-let [entity (crux.api/entity db entity-id)]
                         [[:crux.tx/put (update entity
                                                attribute
                                                #(if (when-let [att (attribute schema)]
                                                       (= :crux.db.cardinality/one (:crux.db/cardinality att)))
                                                   %2
                                                   (if (some? %1)
                                                     (if (or (vector? %) (set? %1))
                                                       (conj %1 %2)
                                                       #{%1 %2})
                                                     #{%2}))
                                                value)]]
                         [[:crux.tx/put (hash-map :crux.db/id entity-id attribute value)]])
                       [[:crux.tx/put :add-uniqueness-failed attribute value]])) ;; TODO need to return log a proper descriptive error somehow
                   )}

   {:crux.db/id :retract
    :crux.db/fn '(fn [ctx entity-id & [attribute value]]
                   (let [db (crux.api/db ctx)
                         schema (crux.api/entity db :schema)]
                     (when-let [entity (crux.api/entity db entity-id)]
                       (when-let [existing-value (attribute entity)]
                         [[:crux.tx/put
                           (if (or (when-let [att (attribute schema)]
                                     (= :crux.db.cardinality/one (:crux.db/cardinality att)))
                                   (= existing-value value)
                                   (and (coll? existing-value) (= 1 (count existing-value)) (= existing-value value)))
                             (dissoc entity attribute)
                             (update entity
                                     attribute
                                     #(into (or (and (set? %1) #{}) (and (vector? %1) [])) (remove #{%2} %1))
                                     value))]]))))}

   {:crux.db/id :retract-entity
    :crux.db/fn '(fn [ctx entity-id]
                   (let [db (crux.api/db ctx)
                         schema (crux.api/entity db :schema)]
                     (when-let [entity (crux.api/entity db entity-id)]
                       (conj
                        (vec
                        (mapcat (fn [[a es]] (for [e es] [:crux.tx/fn :retract e a entity-id]))
                              (map
                               #(vector % (into #{} (map first (crux.api/q db {:find '[e] :where [['e % entity-id]]}))))
                               (map first (remove (fn [[k v]] (not (and (= (:crux.db/cardinality v) :crux.db.cardinality/one)
                                                                        (= (:crux.db/value-type v) :crux.db.type/ref))))
                                                  schema)))
                               ))
                        [:crux.tx/delete entity-id]))))}