Skip to content

Instantly share code, notes, and snippets.

@jebberjeb
Created November 11, 2016 21:26
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save jebberjeb/54d635450978333a95831d9db523835d to your computer and use it in GitHub Desktop.
Save jebberjeb/54d635450978333a95831d9db523835d to your computer and use it in GitHub Desktop.
(ns vatican.schema
"Extract the schema from a Datomic database."
(:require [datomic.api :as d]))
(defn gen-mem-db-uri
"Generate a unique uri for use with an in-memory Datomic database."
[]
(str "datomic:mem://" (d/squuid)))
;; TODO: parameterize the partition
(defn prepare-datom
"Prepares a datom to be transacted by prepending with :db/add, and converting
its entity id into a temp id."
[datom]
(into [:db/add (d/tempid :db.part/tx (- (first datom)))] (rest datom)))
;; TODO: parameterize the partition
(defn prepare-map
"Like `prep-datom` but for maps."
[m]
(-> m
(assoc :db/id (d/tempid :db.part/db))
(assoc :db.install/_attribute :db.part/db)))
(prepare-map {:db/id 5})
;; TODO: doc & refactor
(defn schema-attributes [db]
(let [attributes (d/q '[:find [?e ...]
:where [?e :db/cardinality _]]
db)]
(map (comp (partial into {})
d/touch
(partial d/entity db))
attributes)))
(defn transaction-functions [db]
"Returns datoms related to transaction functions in the database."
(d/q '[:find ?e ?a-ident ?v
:where
[?e :db/fn _]
[?e ?a ?v]
[?a :db/ident ?a-ident]]
db))
(defn partitions [db]
"Return :db/ident values for all database partitions."
(d/q '[:find [?partition ...]
:where
[_ :db.install/partition ?e]
[?e :db/ident ?partition]]
db))
(defn add-partitions! [conn db]
"Transacts the partitions from `db` using `conn."
(let [partitions (disj (set (partitions db))
:db.part/user
:db.part/db
:db.part/tx)]
@(d/transact conn (mapv (fn [part]
{:db/id (d/tempid :db.part/db)
:db/ident part
:db.install/_partition :db.part/db})
partitions))))
(defn add-transaction-functions! [conn db]
"Transacts the transaction functions from `db` using `conn`."
@(d/transact
conn
(mapv prepare-datom
(transaction-functions db))))
(defn add-schema-attributes!
"Transacts the schema attributes from `db` using `conn`."
[conn db]
@(d/transact
conn
(mapv prepare-map
(schema-attributes db))))
;; TODO: Can this be done as one atomic -tx, can these fn be replaced by -tx?
;; Yes, definitely need to remove d/transact from this api.
;; Question, can we add transaction functions to :db.part/user, or should we
;; try to figure out what partition they came from when making their tempids?
;; in this code we're using :db.part/tx
;; in the test we're using :db.part/user
;; does it matter?
(defn clone-db-schema!
"Transacts the schema attributes, partitions, and transaction functions from
`db` using `conn`."
[conn db]
(add-partitions! conn db)
(add-transaction-functions! conn db)
(add-schema-attributes! conn db))
@jebberjeb
Copy link
Author

Clone the schema of a Datomic database.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment