Datomic traverser

datomic_traverser.clj

(ns datomic-traverser
  (:require [clojure.set :as set]
            [datomic.api :as d]
            [loom.graph :as graph]
            [loom.alg :as alg]))

;; An implementation of Loom graph backed by a Datomic db, where nodes are
;; Datomic entities and edges are determined by datoms of attribute type ref,
;; filtered with forward-attr-blacklist and backward-attr-whitelist.
;; node-subset, when present, will restrict the nodes and edges to those
;; in the set.
(deftype DbTraverser [db forward-attr-blacklist backward-attr-whitelist ref-attrs node-subset]
  graph/Graph
  (nodes [_this]
    (or node-subset
        (throw (UnsupportedOperationException.))))
  (edges [_this]
    (throw (UnsupportedOperationException.)))
  (has-node? [_this node]
    (and
     (or (not node-subset) (node-subset node))
     (boolean (d/entity db node))))
  (has-edge? [this n1 n2]
    (and
     (or (not node-subset) (and (node-subset n1) (node-subset n2)))
     (contains? (set (graph/successors* this n1) n2))))
  (successors* [_this node]
    (cond->>
        (distinct
         (concat
          (->> (d/datoms db :eavt node)
               (filter #(and (not (forward-attr-blacklist (:a %)))
                             (ref-attrs (:a %))))
               (map :v))
          (->> (mapcat (partial d/datoms db :vaet node) backward-attr-whitelist)
               (map :e))))
        node-subset (filter node-subset)))
  (out-degree [g node]
    (count (graph/out-edges g node)))
  (out-edges [g node]
    (for [n2 (graph/successors* g node)]
      [node n2])))

(defn db-traverser
  "Returns a DbTraverser backed by the given db and attribute lists."
  [db forward-attr-blacklist backward-attr-whitelist & [node-subset]]
  (let [forward-blacklist (->> forward-attr-blacklist
                               (map #(:db/id (d/entity db %)))
                               set)
        backward-whitelist (->> backward-attr-whitelist
                                (map #(:db/id (d/entity db %)))
                                set)]
    (DbTraverser. db
                  forward-blacklist
                  backward-whitelist
                  (set (d/q '[:find [?a ...] :where [?a :db/valueType :db.type/ref]] db))
                  (when node-subset (set node-subset)))))

(defn mirror-entities-tx
  "Returns a transaction that, when transacted against a database with same schema
  as db, will cause entities specified by ent-ids, as well as their ref'd entities
  as per forward-blacklist and backward-whitelist, to exist in the target db."
  [db forward-blacklist backward-whitelist entids]
  (let [traverser (db-traverser db forward-blacklist backward-whitelist)
        entities (->> entids
                      (map #(:db/id (d/entity db %)))
                      (mapcat #(alg/bf-traverse traverser %))
                      distinct)
        datoms (mapcat (partial d/datoms db :eavt) entities)
        attrs (->> (distinct (map :a datoms)))
        attr-map (into {}
                       (map #(vector % (:db/ident (d/entity db %))))
                       attrs)
        forward-blacklist (->> forward-blacklist
                               (map #(:db/id (d/entity db %)))
                               set)
        ent-set (set entities)]
    (->> datoms
         (remove #(contains? forward-blacklist (:a %)))
         (map (fn [datom]
                [:db/add (str (:e datom))
                 (attr-map (:a datom))
                 (if (contains? ent-set (:v datom))
                   (str (:v datom))
                   (:v datom))])))))

(defn copy-schema-tx
  [source-db target-db]
  (let [find-attrs #(set (d/q '[:find [?ident ...]
                                :where [?attr :db/valueType]
                                [?attr :db/ident ?ident]]
                              %))
        source-attrs (find-attrs source-db)
        target-attrs (find-attrs target-db)]
    (->> (set/difference source-attrs target-attrs)
         (map (partial d/entity source-db))
         (map #(into {:db/id (datomic.db/id-literal [:db.part/db])
                      :db.install/_attribute :db.part/db}
                     %)))))

(comment
  ;; Demo using the DB from https://github.com/Datomic/mbrainz-sample
  ;; Follow the README there to setup
  (def source-url "datomic:dev://localhost:4334/mbrainz-1968-1973")
  (def target-url "datomic:mem://mirror")

  ;; Create an empty in-memory database
  (d/create-database target-url)

  ;; Connect to both
  (def source-conn (d/connect source-url))
  (def target-conn (d/connect target-url))

  ;; Copy over the schema
  @(d/transact target-conn (copy-schema-tx (d/db source-conn) (d/db target-conn)))

  ;; Mirror the UK release of "The Dark Side of the Moon"
  @(d/transact target-conn (mirror-entities-tx (d/db source-conn) [] [] [[:release/gid #uuid "b84ee12a-09ef-421b-82de-0441a926375b"]]))

  ;; Now the target DB contains just one release entity...
  (d/q '[:find (count ?e) . :where [?e :release/gid]] (d/db target-conn))

  ;; ...but it also has all the dependent entities
  (d/touch (d/entity (d/db target-conn) [:release/gid #uuid "b84ee12a-09ef-421b-82de-0441a926375b"])))

deps.edn

{:paths     ["."]
 :deps      {aysylu/loom {:mvn/version "1.0.2"}
             com.datomic/peer {:mvn/version "1.0.6735"}}
 :mvn/repos {"my.datomic.com" {:url "https://my.datomic.com/repo"}}}