Datomic traverser

Felix Barbalet
2025-08-31T01:36:05Z

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"}}}